module io_fortran_lib !------------------------------------------------------------------------------------------------------------------ !! This module provides common I/O routines for data of `integer`, `real`, `complex`, and `character` type, and !! a derived type `String` for advanced character handling and text file I/O. This module is F2018 compliant, has !! no external dependencies, and has a max line length of 120. !------------------------------------------------------------------------------------------------------------------ use, intrinsic :: iso_fortran_env, only: real128, real64, real32, int64, int32, int16, int8, & ! Standard kinds input_unit, output_unit, compiler_version use, intrinsic :: iso_c_binding, only: c_null_char ! The C null character implicit none (type,external) ! No implicit types or interfaces private ! Public API list ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ public :: aprint, to_file, from_file ! Array I/O public :: String, str, cast, join, split, echo ! String I/O public :: NL, SPACE, CR, FF, VT, LF, TAB, HT, BELL, NUL, CNUL, EMPTY_STR ! Constants public :: operator(//), operator(+), operator(-), operator(**), operator(==), operator(/=) ! Operators ! Definitions and Interfaces ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ character(len=1), parameter :: NL = new_line('a') !! The newline character (system agnostic). character(len=1), parameter :: SPACE = achar(32) !! The space character. character(len=1), parameter :: CR = achar(13) !! The carriage return character. character(len=1), parameter :: FF = achar(12) !! The form feed character. character(len=1), parameter :: VT = achar(11) !! The vertical tab character. character(len=1), parameter :: LF = achar(10) !! The line feed character. character(len=1), parameter :: TAB = achar(9) !! The horizontal tab character. character(len=1), parameter :: HT = achar(9) !! The horizontal tab character (alternate name). character(len=1), parameter :: BELL = achar(7) !! The bell/alert character. character(len=1), parameter :: NUL = achar(0) !! The null character. character(len=1), parameter :: CNUL = c_null_char !! The C null character re-exported from iso_c_binding. character(len=0), parameter :: EMPTY_STR = '' !! The empty string. character(len=*), parameter :: COMPILER = compiler_version() character(len=1), parameter :: SEMICOLON = achar(59) ! Semicolon character(len=1), parameter :: POINT = achar(46) ! Full stop character(len=1), parameter :: COMMA = achar(44) ! Comma character(len=1), parameter :: QQUOTE = achar(34) ! Double quote character(len=1), dimension(*), parameter :: INT_FMTS = [ 'i', 'z' ] ! Allowed formats for integers character(len=1), dimension(*), parameter :: REAL_FMTS = [ 'e', 'f', 'z' ] ! Allowed formats for floats character(len=2), dimension(*), parameter :: LOCALES = [ 'US', 'EU' ] ! Allowed locale specifiers character(len=3), dimension(*), parameter :: BINARY_EXT = [ 'dat', 'bin' ] ! Allowed binary extensions character(len=3), dimension(*), parameter :: TEXT_EXT = [ 'csv', 'txt', 'log', & ! Allowed text extensions 'rtf', 'odm', 'odt', & 'ods', 'odf', 'xls', & 'doc', 'org', 'dbf', & 'bed', 'gff', 'gtf' ] character(len=1), dimension(0:15), parameter :: DIGITS_A = [ '0', '1', '2', '3', '4', & '5', '6', '7', '8', '9', & 'a', 'b', 'c', 'd', 'e', 'f' ] integer, dimension(0:15), parameter :: DIGITS_I = [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, & 10, 11, 12, 13, 14, 15 ] type String !-------------------------------------------------------------------------------------------------------------- !! A growable string type for advanced character handling and text file I/O. !! !! For a user reference, see [String](../page/Ref/string.html), !! [String methods](../page/Ref/string-methods.html), and [Operators](../page/Ref/operators.html). !! !! @note TECHNICAL NOTE: The `String` type is memory safe. The user will never need to be concerned about !! accessing invalid memory when using the `String` type. Any operation defined in this documentation for the !! `String` type which may involve a `String` with an unallocated component, or arrays of `String`s in which !! some of the elements may have unallocated components, is well-defined. In all such cases, the component is !! treated as the [empty string](../module/io_fortran_lib.html#variable-empty_str). !-------------------------------------------------------------------------------------------------------------- private character(len=:), allocatable :: s !! Component is a string slice contains private ! Generics ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ generic, public :: cast => cast_string_c128, cast_string_c64, cast_string_c32, & cast_string_r128, cast_string_r64, cast_string_r32, & cast_string_i64, cast_string_i32, cast_string_i16, cast_string_i8 generic, public :: count => count_substring_chars, count_substring_string generic, public :: echo => echo_string generic, public :: push => push_chars, push_string generic, public :: replace => replace_ch_copy, replace_st_copy, replace_chst_copy, & replace_stch_copy generic, public :: replace_inplace => replace_ch_inplace, replace_st_inplace, replace_chst_inplace, & replace_stch_inplace generic, public :: split => split_string generic, public :: write(formatted) => write_string ! Specifics ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ procedure, pass(self), public :: as_str procedure, pass(substring) :: cast_string_c128, cast_string_c64, cast_string_c32, & cast_string_r128, cast_string_r64, cast_string_r32, & cast_string_i64, cast_string_i32, cast_string_i16, cast_string_i8 procedure, pass(self) :: count_substring_chars, count_substring_string procedure, pass(substring) :: echo_string procedure, pass(self), public :: empty procedure, pass(self), public :: join => join_into_self procedure, pass(self) :: join_base procedure, pass(self), public :: len => length procedure, pass(self), public :: len64 => length64 procedure, pass(self) :: push_chars, push_string procedure, pass(self), public :: read_file procedure, pass(self) :: replace_ch_copy, replace_st_copy, replace_chst_copy, & replace_stch_copy, replace_ch_inplace, replace_st_inplace, & replace_chst_inplace, replace_stch_inplace procedure, pass(substring) :: split_string procedure, pass(self), public :: trim => trim_copy procedure, pass(self), public :: trim_inplace procedure, pass(self), public :: write_file procedure, pass(substring) :: write_string final :: scrub end type String interface ! Submodule String_procedures !-------------------------------------------------------------------------------------------------------------- !! Methods for the `String` type. !-------------------------------------------------------------------------------------------------------------- pure recursive module function as_str(self) result(string_slice) !---------------------------------------------------------------------------------------------------------- !! Returns a copy of the string slice component of a scalar `String`. !! !! For a user reference, see [as_str](../page/Ref/string-methods.html#as_str). !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self character(len=:), allocatable :: string_slice end function as_str pure elemental recursive integer module function count_substring_chars(self, match) result(occurrences) !---------------------------------------------------------------------------------------------------------- !! Returns number of non-overlapping occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self character(len=*), intent(in) :: match end function count_substring_chars pure elemental recursive integer module function count_substring_string(self, match) result(occurrences) !---------------------------------------------------------------------------------------------------------- !! Returns number of non-overlapping occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self type(String), intent(in) :: match end function count_substring_string pure elemental recursive module subroutine empty(self) !---------------------------------------------------------------------------------------------------------- !! Sets the string slice component to the empty string elementally. This procedure is identical in function !! to the assignment `self = String()`. !! !! For a user reference, see [empty](../page/Ref/string-methods.html#empty). !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self end subroutine empty pure recursive module subroutine join_into_self(self, tokens, separator) !---------------------------------------------------------------------------------------------------------- !! Joins a `String` vector `tokens` into `self` with given separator. Default separator is SPACE. The !! string slice component will be replaced if already allocated. !! !! For a user reference, see [join](../page/Ref/string-methods.html#join). !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), dimension(:), intent(in) :: tokens character(len=*), intent(in), optional :: separator end subroutine join_into_self pure recursive module subroutine join_base(self, tokens, separator) !---------------------------------------------------------------------------------------------------------- !! Tail recursion routine for `join_string` and `join_into_self`. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), dimension(:), intent(in) :: tokens character(len=*), intent(in) :: separator end subroutine join_base pure elemental recursive integer module function length(self) result(self_len) !---------------------------------------------------------------------------------------------------------- !! Returns the length of the string slice component elementally. Unallocated components return `-1`. !! !! For a user reference, see [len](../page/Ref/string-methods.html#len). !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self end function length pure elemental recursive integer(int64) module function length64(self) result(self_len) !---------------------------------------------------------------------------------------------------------- !! Returns the length of the string slice component elementally. Unallocated components return `-1`. This !! function is identical to `len` for strings of 2,147,483,647 bytes or smaller. !! !! For a user reference, see [len](../page/Ref/string-methods.html#len). !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self end function length64 pure elemental recursive module subroutine push_chars(self, substring) !---------------------------------------------------------------------------------------------------------- !! Appends characters to the string slice component elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self character(len=*), intent(in) :: substring end subroutine push_chars pure elemental recursive module subroutine push_string(self, substring) !---------------------------------------------------------------------------------------------------------- !! Appends string to the string slice component elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), intent(in) :: substring end subroutine push_string impure recursive module subroutine read_file(self, file_name, cell_array, row_separator, column_separator) !---------------------------------------------------------------------------------------------------------- !! Reads raw text file contents into `self` and optionally populates a cell array using the designated !! `row_separator` and `column_separator` whose default values are `LF` and `COMMA` respectively. !! !! For a user reference, see [read_file](../page/Ref/string-methods.html#read_file). !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self character(len=*), intent(in) :: file_name type(String), allocatable, dimension(:,:), intent(out), optional :: cell_array character(len=*), intent(in), optional :: row_separator, column_separator end subroutine read_file pure elemental recursive type(String) module function replace_ch_copy(self, match, substring, back) result(new) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self character(len=*), intent(in) :: match, substring logical, intent(in), optional :: back end function replace_ch_copy pure elemental recursive type(String) module function replace_st_copy(self, match, substring, back) result(new) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self type(String), intent(in) :: match, substring logical, intent(in), optional :: back end function replace_st_copy pure elemental recursive type(String) module function replace_chst_copy(self, match,substring,back) result(new) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self character(len=*), intent(in) :: match type(String), intent(in) :: substring logical, intent(in), optional :: back end function replace_chst_copy pure elemental recursive type(String) module function replace_stch_copy(self, match,substring,back) result(new) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self type(String), intent(in) :: match character(len=*), intent(in) :: substring logical, intent(in), optional :: back end function replace_stch_copy pure elemental recursive module subroutine replace_ch_inplace(self, match, substring, back) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self character(len=*), intent(in) :: match, substring logical, intent(in), optional :: back end subroutine replace_ch_inplace pure elemental recursive module subroutine replace_st_inplace(self, match, substring, back) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), intent(in) :: match, substring logical, intent(in), optional :: back end subroutine replace_st_inplace pure elemental recursive module subroutine replace_chst_inplace(self, match, substring, back) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self character(len=*), intent(in) :: match type(String), intent(in) :: substring logical, intent(in), optional :: back end subroutine replace_chst_inplace pure elemental recursive module subroutine replace_stch_inplace(self, match, substring, back) !---------------------------------------------------------------------------------------------------------- !! Matches and replaces all occurrences of a substring elementally in place. !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), intent(in) :: match character(len=*), intent(in) :: substring logical, intent(in), optional :: back end subroutine replace_stch_inplace pure elemental recursive type(String) module function trim_copy(self) result(new) !---------------------------------------------------------------------------------------------------------- !! Returns a copy of a `String` elementally in which each string slice component has been trimmed of any !! leading or trailing whitespace. !! !! For a user reference, see [trim](../page/Ref/string-methods.html#trim). !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: self end function trim_copy pure elemental recursive module subroutine trim_inplace(self) !---------------------------------------------------------------------------------------------------------- !! Removes any leading or trailing whitespace of the string slice component of a `String` elementally and !! in place. !! !! For a user reference, see [trim_inplace](../page/Ref/string-methods.html#trim_inplace). !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self end subroutine trim_inplace impure recursive module subroutine write_file(self, cell_array,file_name,row_separator,column_separator,append) !---------------------------------------------------------------------------------------------------------- !! Writes the content of a cell array to a text file. The cell array's entire contents are populated into !! `self` and then streamed to an external text file using the designated `row_separator` and !! `column_separator` whose default values are `LF` and `COMMA` respectively. !! !! For a user reference, see [write_file](../page/Ref/string-methods.html#write_file). !---------------------------------------------------------------------------------------------------------- class(String), intent(inout) :: self type(String), dimension(:,:), intent(inout) :: cell_array character(len=*), intent(in) :: file_name character(len=*), intent(in), optional :: row_separator, column_separator logical, intent(in), optional :: append end subroutine write_file impure recursive module subroutine write_string(substring, unit, iotype, v_list, iostat, iomsg) !---------------------------------------------------------------------------------------------------------- !! Formatted write DTIO procedure for type `String`. !---------------------------------------------------------------------------------------------------------- class(String), intent(in) :: substring integer, intent(in) :: unit character(len=*), intent(in) :: iotype integer, dimension(:), intent(in) :: v_list integer, intent(out) :: iostat character(len=*), intent(inout) :: iomsg end subroutine write_string pure elemental recursive module subroutine scrub(self) !---------------------------------------------------------------------------------------------------------- !! Finalization procedure for type `String`. !---------------------------------------------------------------------------------------------------------- type(String), intent(inout) :: self end subroutine scrub end interface interface operator(//) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Concatenation operator for `character` and `String`, lifted from `character`. Mixed type concatenation of !! `character` and `String` is explicitly defined. !! !! For a user reference, see [Concatenation](../page/Ref/operators.html#concatenation). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive type(String) module function string_concatenation(Stringl, Stringr) result(new) class(String), intent(in) :: Stringl, Stringr end function string_concatenation pure elemental recursive type(String) module function string_char_concatenation(Stringl, charsr) result(new) class(String), intent(in) :: Stringl character(len=*), intent(in) :: charsr end function string_char_concatenation pure elemental recursive type(String) module function char_string_concatenation(charsl, Stringr) result(new) character(len=*), intent(in) :: charsl class(String), intent(in) :: Stringr end function char_string_concatenation end interface interface operator(+) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Concatenation operator for `character` and `String` (as addition). Mixed type concatenation of !! `character` and `String` is explicitly defined. !! !! For a user reference, see [Concatenation](../page/Ref/operators.html#concatenation). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive module function char_concat_plus(charsl, charsr) result(new) character(len=*), intent(in) :: charsl, charsr character(len=len(charsl)+len(charsr)) :: new end function char_concat_plus pure elemental recursive type(String) module function string_concat_plus(Stringl, Stringr) result(new) class(String), intent(in) :: Stringl, Stringr end function string_concat_plus pure elemental recursive type(String) module function string_char_concat_plus(Stringl, charsr) result(new) class(String), intent(in) :: Stringl character(len=*), intent(in) :: charsr end function string_char_concat_plus pure elemental recursive type(String) module function char_string_concat_plus(charsl, Stringr) result(new) character(len=*), intent(in) :: charsl class(String), intent(in) :: Stringr end function char_string_concat_plus end interface interface operator(-) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Excision operator for `character` and `String` (as subtraction). Mixed type excision of `character` and !! `String` is explicitly defined. !! !! For a user reference, see [Excision](../page/Ref/operators.html#excision). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive type(String) module function char_excision(charsl, charsr) result(new) character(len=*), intent(in) :: charsl, charsr end function char_excision pure elemental recursive type(String) module function string_excision(Stringl, Stringr) result(new) class(String), intent(in) :: Stringl, Stringr end function string_excision pure elemental recursive type(String) module function string_char_excision(Stringl, charsr) result(new) class(String), intent(in) :: Stringl character(len=*), intent(in) :: charsr end function string_char_excision pure elemental recursive type(String) module function char_string_excision(charsl, Stringr) result(new) character(len=*), intent(in) :: charsl class(String), intent(in) :: Stringr end function char_string_excision end interface interface operator(**) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Repetition operator for `character` and `String` (as exponentiation). !! !! For a user reference, see [Repetition](../page/Ref/operators.html#repetition). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive module function repeat_chars(char_base, ncopies) result(new) character(len=*), intent(in) :: char_base integer, intent(in) :: ncopies character(len=len(char_base)*ncopies) :: new end function repeat_chars pure elemental recursive type(String) module function repeat_String(String_base, ncopies) result(new) class(String), intent(in) :: String_base integer, intent(in) :: ncopies end function repeat_String end interface interface operator(==) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Equivalence operator for `character` and `String`. Mixed type equivalence of `character` and `String` is !! explicitly defined. !! !! For a user reference, see [Equivalence](../page/Ref/operators.html#equivalence). !! !! @note The equivalence operator `==` is interchangeable with `.eq.`. !-------------------------------------------------------------------------------------------------------------- pure elemental recursive logical module function string_equivalence(Stringl, Stringr) result(equal) class(String), intent(in) :: Stringl, Stringr end function string_equivalence pure elemental recursive logical module function string_char_equivalence(Stringl, charsr) result(equal) class(String), intent(in) :: Stringl character(len=*), intent(in) :: charsr end function string_char_equivalence pure elemental recursive logical module function char_string_equivalence(charsl, Stringr) result(equal) character(len=*), intent(in) :: charsl class(String), intent(in) :: Stringr end function char_string_equivalence end interface interface operator(/=) ! Submodule operators !-------------------------------------------------------------------------------------------------------------- !! Non-equivalence operator for `character` and `String`. Mixed type non-equivalence of `character` and !! `String` is explicitly defined. !! !! For a user reference, see [Non-equivalence](../page/Ref/operators.html#non-equivalence). !! !! @note The non-equivalence operator `/=` is interchangeable with `.ne.`. !-------------------------------------------------------------------------------------------------------------- pure elemental recursive logical module function string_nonequivalence(Stringl, Stringr) result(unequal) class(String), intent(in) :: Stringl, Stringr end function string_nonequivalence pure elemental recursive logical module function string_char_nonequivalence(Stringl, charsr) result(unequal) class(String), intent(in) :: Stringl character(len=*), intent(in) :: charsr end function string_char_nonequivalence pure elemental recursive logical module function char_string_nonequivalence(charsl, Stringr) result(unequal) character(len=*), intent(in) :: charsl class(String), intent(in) :: Stringr end function char_string_nonequivalence end interface interface String ! Submodule internal_io !-------------------------------------------------------------------------------------------------------------- !! Function for transforming numeric or `character` data into a [String](../type/string.html) type. !! !! The interface for `String` is identical to that of `str` but with a return type of `String`, allowing for !! elemental assignments and access to the various `String` methods for advanced character handling. For the !! complement of `String`, see [cast](../page/Ref/cast.html). !! !! For a user reference, see [String](../page/Ref/string.html), !! [String methods](../page/Ref/string-methods.html), and [Operators](../page/Ref/operators.html). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive type(String) module function new_Str_c128(x, locale, fmt, decimals, im) result(new) complex(real128), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end function new_Str_c128 pure elemental recursive type(String) module function new_Str_c64(x, locale, fmt, decimals, im) result(new) complex(real64), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end function new_Str_c64 pure elemental recursive type(String) module function new_Str_c32(x, locale, fmt, decimals, im) result(new) complex(real32), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end function new_Str_c32 pure elemental recursive type(String) module function new_Str_r128(x, locale, fmt, decimals) result(new) real(real128), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end function new_Str_r128 pure elemental recursive type(String) module function new_Str_r64(x, locale, fmt, decimals) result(new) real(real64), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end function new_Str_r64 pure elemental recursive type(String) module function new_Str_r32(x, locale, fmt, decimals) result(new) real(real32), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end function new_Str_r32 pure elemental recursive type(String) module function new_Str_i64(x, fmt) result(new) integer(int64), intent(in) :: x character(len=*), intent(in), optional :: fmt end function new_Str_i64 pure elemental recursive type(String) module function new_Str_i32(x, fmt) result(new) integer(int32), intent(in) :: x character(len=*), intent(in), optional :: fmt end function new_Str_i32 pure elemental recursive type(String) module function new_Str_i16(x, fmt) result(new) integer(int16), intent(in) :: x character(len=*), intent(in), optional :: fmt end function new_Str_i16 pure elemental recursive type(String) module function new_Str_i8(x, fmt) result(new) integer(int8), intent(in) :: x character(len=*), intent(in), optional :: fmt end function new_Str_i8 pure elemental recursive type(String) module function new_Str_string(x) result(new) class(String), intent(in) :: x end function new_Str_string pure elemental recursive type(String) module function new_Str_char(x) result(new) character(len=*), intent(in) :: x end function new_Str_char pure elemental recursive type(String) module function new_Str_empty() result(new) ! No arguments end function new_Str_empty end interface interface str ! Submodule internal_io !-------------------------------------------------------------------------------------------------------------- !! Function for representing a scalar number as a `character` string. !! !! By default behavior, `str` will write a `real` or `complex` number using a number of significant digits !! required in the worst case for a lossless round-trip conversion starting with the internal model !! representation of `x`. For the complement of `str`, see [cast](../page/Ref/cast.html). !! !! For a user reference, see [str](../page/Ref/str.html). !-------------------------------------------------------------------------------------------------------------- pure recursive module function str_c128(x, locale, fmt, decimals, im) result(x_str) complex(real128), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im character(len=:), allocatable :: x_str end function str_c128 pure recursive module function str_c64(x, locale, fmt, decimals, im) result(x_str) complex(real64), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im character(len=:), allocatable :: x_str end function str_c64 pure recursive module function str_c32(x, locale, fmt, decimals, im) result(x_str) complex(real32), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im character(len=:), allocatable :: x_str end function str_c32 pure recursive module function str_r128(x, locale, fmt, decimals) result(x_str) real(real128), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=:), allocatable :: x_str end function str_r128 pure recursive module function str_r64(x, locale, fmt, decimals) result(x_str) real(real64), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=:), allocatable :: x_str end function str_r64 pure recursive module function str_r32(x, locale, fmt, decimals) result(x_str) real(real32), intent(in) :: x character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=:), allocatable :: x_str end function str_r32 pure recursive module function str_i64(x, fmt) result(x_str) integer(int64), intent(in) :: x character(len=*), intent(in), optional :: fmt character(len=:), allocatable :: x_str end function str_i64 pure recursive module function str_i32(x, fmt) result(x_str) integer(int32), intent(in) :: x character(len=*), intent(in), optional :: fmt character(len=:), allocatable :: x_str end function str_i32 pure recursive module function str_i16(x, fmt) result(x_str) integer(int16), intent(in) :: x character(len=*), intent(in), optional :: fmt character(len=:), allocatable :: x_str end function str_i16 pure recursive module function str_i8(x, fmt) result(x_str) integer(int8), intent(in) :: x character(len=*), intent(in), optional :: fmt character(len=:), allocatable :: x_str end function str_i8 pure recursive module function str_string(x) result(x_str) class(String), intent(in) :: x character(len=:), allocatable :: x_str end function str_string pure recursive module function str_char(x) result(x_str) character(len=*), intent(in) :: x character(len=:), allocatable :: x_str end function str_char pure recursive module function str_empty() result(x_str) character(len=:), allocatable :: x_str end function str_empty end interface interface cast ! Submodule internal_io !-------------------------------------------------------------------------------------------------------------- !! Subroutine for casting a `character` or `String` into a number. !! !! For the complement of `cast`, see [String](../page/Ref/string.html) and [str](../page/Ref/str.html). !! !! For a user reference, see [cast](../page/Ref/cast.html). !-------------------------------------------------------------------------------------------------------------- pure elemental recursive module subroutine cast_string_c128(substring, into, locale, fmt, im) class(String), intent(in) :: substring complex(real128), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_string_c128 pure elemental recursive module subroutine cast_string_c64(substring, into, locale, fmt, im) class(String), intent(in) :: substring complex(real64), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_string_c64 pure elemental recursive module subroutine cast_string_c32(substring, into, locale, fmt, im) class(String), intent(in) :: substring complex(real32), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_string_c32 pure elemental recursive module subroutine cast_string_r128(substring, into, locale, fmt) class(String), intent(in) :: substring real(real128), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_string_r128 pure elemental recursive module subroutine cast_string_r64(substring, into, locale, fmt) class(String), intent(in) :: substring real(real64), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_string_r64 pure elemental recursive module subroutine cast_string_r32(substring, into, locale, fmt) class(String), intent(in) :: substring real(real32), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_string_r32 pure elemental recursive module subroutine cast_string_i64(substring, into, fmt) class(String), intent(in) :: substring integer(int64), intent(out) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_string_i64 pure elemental recursive module subroutine cast_string_i32(substring, into, fmt) class(String), intent(in) :: substring integer(int32), intent(out) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_string_i32 pure elemental recursive module subroutine cast_string_i16(substring, into, fmt) class(String), intent(in) :: substring integer(int16), intent(out) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_string_i16 pure elemental recursive module subroutine cast_string_i8(substring, into, fmt) class(String), intent(in) :: substring integer(int8), intent(out) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_string_i8 pure recursive module subroutine cast_c128(substring, into, locale, fmt, im) character(len=*), intent(in) :: substring complex(real128), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_c128 pure recursive module subroutine cast_c64(substring, into, locale, fmt, im) character(len=*), intent(in) :: substring complex(real64), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_c64 pure recursive module subroutine cast_c32(substring, into, locale, fmt, im) character(len=*), intent(in) :: substring complex(real32), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine cast_c32 pure recursive module subroutine cast_r128(substring, into, locale, fmt) character(len=*), intent(in) :: substring real(real128), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_r128 pure recursive module subroutine cast_r64(substring, into, locale, fmt) character(len=*), intent(in) :: substring real(real64), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_r64 pure recursive module subroutine cast_r32(substring, into, locale, fmt) character(len=*), intent(in) :: substring real(real32), intent(out) :: into character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: fmt end subroutine cast_r32 pure recursive module subroutine cast_i64(substring, into, fmt) character(len=*), intent(in) :: substring integer(int64), intent(out) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i64 pure recursive module subroutine cast_i32(substring, into, fmt) character(len=*), intent(in) :: substring integer(int32), intent(out) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i32 pure recursive module subroutine cast_i16(substring, into, fmt) character(len=*), intent(in) :: substring integer(int16), intent(out) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i16 pure recursive module subroutine cast_i8(substring, into, fmt) character(len=*), intent(in) :: substring integer(int8), intent(out) :: into character(len=*), intent(in), optional :: fmt end subroutine cast_i8 end interface interface join ! Submodule join_split !-------------------------------------------------------------------------------------------------------------- !! Function for joining a vector of `tokens` into a scalar `character` or `String`. !! !! For the complement of `join`, see [split](../page/Ref/join-split.html). !! !! For a user reference, see [join](../page/Ref/join-split.html). !-------------------------------------------------------------------------------------------------------------- pure recursive module function join_char(tokens, separator) result(new) character(len=*), dimension(:), intent(in) :: tokens character(len=*), intent(in), optional :: separator character(len=:), allocatable :: new end function join_char pure recursive type(String) module function join_string(tokens, separator) result(new) type(String), dimension(:), intent(in) :: tokens character(len=*), intent(in), optional :: separator end function join_string end interface interface split ! Submodule join_split !-------------------------------------------------------------------------------------------------------------- !! Function for splitting a scalar `character` or `String` into a vector of `tokens`. !! !! For the complement of `split`, see [join](../page/Ref/join-split.html). !! !! For a user reference, see [split](../page/Ref/join-split.html). !-------------------------------------------------------------------------------------------------------------- pure recursive module function split_char(substring, separator) result(tokens) character(len=*), intent(in) :: substring character(len=*), intent(in), optional :: separator type(String), allocatable, dimension(:) :: tokens end function split_char pure recursive module function split_string(substring, separator) result(tokens) class(String), intent(in) :: substring character(len=*), intent(in), optional :: separator type(String), allocatable, dimension(:) :: tokens end function split_string end interface interface to_file ! Submodule file_io !-------------------------------------------------------------------------------------------------------------- !! Subroutine for writing an array of uniform numeric data type to an external file. !! !! The file `file_name` will be created if it does not already exist and will be overwritten if it does exist. !! Writing to text is allowed for arrays of rank `1` or `2`, and writing to binary is allowed for arrays of any !! rank `1`-`15`. Any invalid actual arguments will be ignored, defaults will be assumed, and a warning message !! will be issued on stdout. !! !! For a user reference, see [to_file](../page/Ref/to_file.html). !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine to_file_1dc128(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_1dc128 impure recursive module subroutine to_file_1dc64(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_1dc64 impure recursive module subroutine to_file_1dc32(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_1dc32 impure recursive module subroutine to_file_2dc128(x, file_name, header, locale, delim, fmt, decimals, im) complex(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_2dc128 impure recursive module subroutine to_file_2dc64(x, file_name, header, locale, delim, fmt, decimals, im) complex(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_2dc64 impure recursive module subroutine to_file_2dc32(x, file_name, header, locale, delim, fmt, decimals, im) complex(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine to_file_2dc32 impure recursive module subroutine to_file_3dc128(x, file_name) complex(real128), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dc128 impure recursive module subroutine to_file_3dc64(x, file_name) complex(real64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dc64 impure recursive module subroutine to_file_3dc32(x, file_name) complex(real32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dc32 impure recursive module subroutine to_file_4dc128(x, file_name) complex(real128), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dc128 impure recursive module subroutine to_file_4dc64(x, file_name) complex(real64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dc64 impure recursive module subroutine to_file_4dc32(x, file_name) complex(real32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dc32 impure recursive module subroutine to_file_5dc128(x, file_name) complex(real128), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dc128 impure recursive module subroutine to_file_5dc64(x, file_name) complex(real64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dc64 impure recursive module subroutine to_file_5dc32(x, file_name) complex(real32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dc32 impure recursive module subroutine to_file_6dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dc128 impure recursive module subroutine to_file_6dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dc64 impure recursive module subroutine to_file_6dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dc32 impure recursive module subroutine to_file_7dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dc128 impure recursive module subroutine to_file_7dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dc64 impure recursive module subroutine to_file_7dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dc32 impure recursive module subroutine to_file_8dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dc128 impure recursive module subroutine to_file_8dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dc64 impure recursive module subroutine to_file_8dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dc32 impure recursive module subroutine to_file_9dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dc128 impure recursive module subroutine to_file_9dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dc64 impure recursive module subroutine to_file_9dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dc32 impure recursive module subroutine to_file_10dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dc128 impure recursive module subroutine to_file_10dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dc64 impure recursive module subroutine to_file_10dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dc32 impure recursive module subroutine to_file_11dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dc128 impure recursive module subroutine to_file_11dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dc64 impure recursive module subroutine to_file_11dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dc32 impure recursive module subroutine to_file_12dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dc128 impure recursive module subroutine to_file_12dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dc64 impure recursive module subroutine to_file_12dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dc32 impure recursive module subroutine to_file_13dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dc128 impure recursive module subroutine to_file_13dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dc64 impure recursive module subroutine to_file_13dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dc32 impure recursive module subroutine to_file_14dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dc128 impure recursive module subroutine to_file_14dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dc64 impure recursive module subroutine to_file_14dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dc32 impure recursive module subroutine to_file_15dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dc128 impure recursive module subroutine to_file_15dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dc64 impure recursive module subroutine to_file_15dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dc32 impure recursive module subroutine to_file_1dr128(x, file_name, header, dim, locale, delim, fmt, decimals) real(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_1dr128 impure recursive module subroutine to_file_1dr64(x, file_name, header, dim, locale, delim, fmt, decimals) real(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_1dr64 impure recursive module subroutine to_file_1dr32(x, file_name, header, dim, locale, delim, fmt, decimals) real(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_1dr32 impure recursive module subroutine to_file_2dr128(x, file_name, header, locale, delim, fmt, decimals) real(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_2dr128 impure recursive module subroutine to_file_2dr64(x, file_name, header, locale, delim, fmt, decimals) real(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_2dr64 impure recursive module subroutine to_file_2dr32(x, file_name, header, locale, delim, fmt, decimals) real(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine to_file_2dr32 impure recursive module subroutine to_file_3dr128(x, file_name) real(real128), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dr128 impure recursive module subroutine to_file_3dr64(x, file_name) real(real64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dr64 impure recursive module subroutine to_file_3dr32(x, file_name) real(real32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3dr32 impure recursive module subroutine to_file_4dr128(x, file_name) real(real128), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dr128 impure recursive module subroutine to_file_4dr64(x, file_name) real(real64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dr64 impure recursive module subroutine to_file_4dr32(x, file_name) real(real32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4dr32 impure recursive module subroutine to_file_5dr128(x, file_name) real(real128), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dr128 impure recursive module subroutine to_file_5dr64(x, file_name) real(real64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dr64 impure recursive module subroutine to_file_5dr32(x, file_name) real(real32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5dr32 impure recursive module subroutine to_file_6dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dr128 impure recursive module subroutine to_file_6dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dr64 impure recursive module subroutine to_file_6dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6dr32 impure recursive module subroutine to_file_7dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dr128 impure recursive module subroutine to_file_7dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dr64 impure recursive module subroutine to_file_7dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7dr32 impure recursive module subroutine to_file_8dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dr128 impure recursive module subroutine to_file_8dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dr64 impure recursive module subroutine to_file_8dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8dr32 impure recursive module subroutine to_file_9dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dr128 impure recursive module subroutine to_file_9dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dr64 impure recursive module subroutine to_file_9dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9dr32 impure recursive module subroutine to_file_10dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dr128 impure recursive module subroutine to_file_10dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dr64 impure recursive module subroutine to_file_10dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10dr32 impure recursive module subroutine to_file_11dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dr128 impure recursive module subroutine to_file_11dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dr64 impure recursive module subroutine to_file_11dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11dr32 impure recursive module subroutine to_file_12dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dr128 impure recursive module subroutine to_file_12dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dr64 impure recursive module subroutine to_file_12dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12dr32 impure recursive module subroutine to_file_13dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dr128 impure recursive module subroutine to_file_13dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dr64 impure recursive module subroutine to_file_13dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13dr32 impure recursive module subroutine to_file_14dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dr128 impure recursive module subroutine to_file_14dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dr64 impure recursive module subroutine to_file_14dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14dr32 impure recursive module subroutine to_file_15dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dr128 impure recursive module subroutine to_file_15dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dr64 impure recursive module subroutine to_file_15dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15dr32 impure recursive module subroutine to_file_1di64(x, file_name, header, dim, delim, fmt) integer(int64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_1di64 impure recursive module subroutine to_file_1di32(x, file_name, header, dim, delim, fmt) integer(int32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_1di32 impure recursive module subroutine to_file_1di16(x, file_name, header, dim, delim, fmt) integer(int16), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_1di16 impure recursive module subroutine to_file_1di8(x, file_name, header, dim, delim, fmt) integer(int8), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header integer, intent(in), optional :: dim character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_1di8 impure recursive module subroutine to_file_2di64(x, file_name, header, delim, fmt) integer(int64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_2di64 impure recursive module subroutine to_file_2di32(x, file_name, header, delim, fmt) integer(int32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_2di32 impure recursive module subroutine to_file_2di16(x, file_name, header, delim, fmt) integer(int16), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_2di16 impure recursive module subroutine to_file_2di8(x, file_name, header, delim, fmt) integer(int8), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine to_file_2di8 impure recursive module subroutine to_file_3di64(x, file_name) integer(int64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3di64 impure recursive module subroutine to_file_3di32(x, file_name) integer(int32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3di32 impure recursive module subroutine to_file_3di16(x, file_name) integer(int16), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3di16 impure recursive module subroutine to_file_3di8(x, file_name) integer(int8), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_3di8 impure recursive module subroutine to_file_4di64(x, file_name) integer(int64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4di64 impure recursive module subroutine to_file_4di32(x, file_name) integer(int32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4di32 impure recursive module subroutine to_file_4di16(x, file_name) integer(int16), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4di16 impure recursive module subroutine to_file_4di8(x, file_name) integer(int8), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_4di8 impure recursive module subroutine to_file_5di64(x, file_name) integer(int64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5di64 impure recursive module subroutine to_file_5di32(x, file_name) integer(int32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5di32 impure recursive module subroutine to_file_5di16(x, file_name) integer(int16), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5di16 impure recursive module subroutine to_file_5di8(x, file_name) integer(int8), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_5di8 impure recursive module subroutine to_file_6di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6di64 impure recursive module subroutine to_file_6di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6di32 impure recursive module subroutine to_file_6di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6di16 impure recursive module subroutine to_file_6di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_6di8 impure recursive module subroutine to_file_7di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7di64 impure recursive module subroutine to_file_7di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7di32 impure recursive module subroutine to_file_7di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7di16 impure recursive module subroutine to_file_7di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_7di8 impure recursive module subroutine to_file_8di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8di64 impure recursive module subroutine to_file_8di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8di32 impure recursive module subroutine to_file_8di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8di16 impure recursive module subroutine to_file_8di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_8di8 impure recursive module subroutine to_file_9di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9di64 impure recursive module subroutine to_file_9di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9di32 impure recursive module subroutine to_file_9di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9di16 impure recursive module subroutine to_file_9di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_9di8 impure recursive module subroutine to_file_10di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10di64 impure recursive module subroutine to_file_10di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10di32 impure recursive module subroutine to_file_10di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10di16 impure recursive module subroutine to_file_10di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_10di8 impure recursive module subroutine to_file_11di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11di64 impure recursive module subroutine to_file_11di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11di32 impure recursive module subroutine to_file_11di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11di16 impure recursive module subroutine to_file_11di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_11di8 impure recursive module subroutine to_file_12di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12di64 impure recursive module subroutine to_file_12di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12di32 impure recursive module subroutine to_file_12di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12di16 impure recursive module subroutine to_file_12di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_12di8 impure recursive module subroutine to_file_13di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13di64 impure recursive module subroutine to_file_13di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13di32 impure recursive module subroutine to_file_13di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13di16 impure recursive module subroutine to_file_13di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_13di8 impure recursive module subroutine to_file_14di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14di64 impure recursive module subroutine to_file_14di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14di32 impure recursive module subroutine to_file_14di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14di16 impure recursive module subroutine to_file_14di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_14di8 impure recursive module subroutine to_file_15di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15di64 impure recursive module subroutine to_file_15di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15di32 impure recursive module subroutine to_file_15di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15di16 impure recursive module subroutine to_file_15di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_file_15di8 end interface interface from_file ! Submodule file_io !-------------------------------------------------------------------------------------------------------------- !! Subroutine for reading an external file of uniform numeric data type and format into an array. !! !! In the event that any actual arguments provided to `from_file` are invalid, the subprogram will not allow !! progression of execution of the caller and will issue an `error stop`. This is due to the critical nature of !! reads and the fact that the procedure may not be able to make the proper assumptions about the data being !! read. !! !! For a user reference, see [from_file](../page/Ref/from_file.html). !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine from_textfile_1dc128(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_1dc128 impure recursive module subroutine from_binaryfile_1dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dc128 impure recursive module subroutine from_textfile_1dc64(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_1dc64 impure recursive module subroutine from_binaryfile_1dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dc64 impure recursive module subroutine from_textfile_1dc32(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_1dc32 impure recursive module subroutine from_binaryfile_1dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dc32 impure recursive module subroutine from_textfile_2dc128(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_2dc128 impure recursive module subroutine from_binaryfile_2dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dc128 impure recursive module subroutine from_textfile_2dc64(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_2dc64 impure recursive module subroutine from_binaryfile_2dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dc64 impure recursive module subroutine from_textfile_2dc32(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt character(len=*), intent(in), optional :: im end subroutine from_textfile_2dc32 impure recursive module subroutine from_binaryfile_2dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dc32 impure recursive module subroutine from_file_3dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dc128 impure recursive module subroutine from_file_3dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dc64 impure recursive module subroutine from_file_3dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dc32 impure recursive module subroutine from_file_4dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dc128 impure recursive module subroutine from_file_4dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dc64 impure recursive module subroutine from_file_4dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dc32 impure recursive module subroutine from_file_5dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dc128 impure recursive module subroutine from_file_5dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dc64 impure recursive module subroutine from_file_5dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dc32 impure recursive module subroutine from_file_6dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dc128 impure recursive module subroutine from_file_6dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dc64 impure recursive module subroutine from_file_6dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dc32 impure recursive module subroutine from_file_7dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dc128 impure recursive module subroutine from_file_7dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dc64 impure recursive module subroutine from_file_7dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dc32 impure recursive module subroutine from_file_8dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dc128 impure recursive module subroutine from_file_8dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dc64 impure recursive module subroutine from_file_8dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dc32 impure recursive module subroutine from_file_9dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dc128 impure recursive module subroutine from_file_9dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dc64 impure recursive module subroutine from_file_9dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dc32 impure recursive module subroutine from_file_10dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dc128 impure recursive module subroutine from_file_10dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dc64 impure recursive module subroutine from_file_10dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dc32 impure recursive module subroutine from_file_11dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dc128 impure recursive module subroutine from_file_11dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dc64 impure recursive module subroutine from_file_11dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dc32 impure recursive module subroutine from_file_12dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dc128 impure recursive module subroutine from_file_12dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dc64 impure recursive module subroutine from_file_12dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dc32 impure recursive module subroutine from_file_13dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dc128 impure recursive module subroutine from_file_13dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dc64 impure recursive module subroutine from_file_13dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dc32 impure recursive module subroutine from_file_14dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dc128 impure recursive module subroutine from_file_14dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dc64 impure recursive module subroutine from_file_14dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dc32 impure recursive module subroutine from_file_15dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dc128 impure recursive module subroutine from_file_15dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dc64 impure recursive module subroutine from_file_15dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dc32 impure recursive module subroutine from_textfile_1dr128(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1dr128 impure recursive module subroutine from_binaryfile_1dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dr128 impure recursive module subroutine from_textfile_1dr64(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1dr64 impure recursive module subroutine from_binaryfile_1dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dr64 impure recursive module subroutine from_textfile_1dr32(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1dr32 impure recursive module subroutine from_binaryfile_1dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1dr32 impure recursive module subroutine from_textfile_2dr128(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2dr128 impure recursive module subroutine from_binaryfile_2dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dr128 impure recursive module subroutine from_textfile_2dr64(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2dr64 impure recursive module subroutine from_binaryfile_2dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dr64 impure recursive module subroutine from_textfile_2dr32(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: locale character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2dr32 impure recursive module subroutine from_binaryfile_2dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2dr32 impure recursive module subroutine from_file_3dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dr128 impure recursive module subroutine from_file_3dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dr64 impure recursive module subroutine from_file_3dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3dr32 impure recursive module subroutine from_file_4dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dr128 impure recursive module subroutine from_file_4dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dr64 impure recursive module subroutine from_file_4dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4dr32 impure recursive module subroutine from_file_5dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dr128 impure recursive module subroutine from_file_5dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dr64 impure recursive module subroutine from_file_5dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5dr32 impure recursive module subroutine from_file_6dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dr128 impure recursive module subroutine from_file_6dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dr64 impure recursive module subroutine from_file_6dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6dr32 impure recursive module subroutine from_file_7dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dr128 impure recursive module subroutine from_file_7dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dr64 impure recursive module subroutine from_file_7dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7dr32 impure recursive module subroutine from_file_8dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dr128 impure recursive module subroutine from_file_8dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dr64 impure recursive module subroutine from_file_8dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8dr32 impure recursive module subroutine from_file_9dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dr128 impure recursive module subroutine from_file_9dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dr64 impure recursive module subroutine from_file_9dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9dr32 impure recursive module subroutine from_file_10dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dr128 impure recursive module subroutine from_file_10dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dr64 impure recursive module subroutine from_file_10dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10dr32 impure recursive module subroutine from_file_11dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dr128 impure recursive module subroutine from_file_11dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dr64 impure recursive module subroutine from_file_11dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11dr32 impure recursive module subroutine from_file_12dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dr128 impure recursive module subroutine from_file_12dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dr64 impure recursive module subroutine from_file_12dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12dr32 impure recursive module subroutine from_file_13dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dr128 impure recursive module subroutine from_file_13dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dr64 impure recursive module subroutine from_file_13dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13dr32 impure recursive module subroutine from_file_14dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dr128 impure recursive module subroutine from_file_14dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dr64 impure recursive module subroutine from_file_14dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14dr32 impure recursive module subroutine from_file_15dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dr128 impure recursive module subroutine from_file_15dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dr64 impure recursive module subroutine from_file_15dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15dr32 impure recursive module subroutine from_textfile_1di64(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1di64 impure recursive module subroutine from_binaryfile_1di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1di64 impure recursive module subroutine from_textfile_1di32(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1di32 impure recursive module subroutine from_binaryfile_1di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1di32 impure recursive module subroutine from_textfile_1di16(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1di16 impure recursive module subroutine from_binaryfile_1di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1di16 impure recursive module subroutine from_textfile_1di8(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_1di8 impure recursive module subroutine from_binaryfile_1di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_1di8 impure recursive module subroutine from_textfile_2di64(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2di64 impure recursive module subroutine from_binaryfile_2di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2di64 impure recursive module subroutine from_textfile_2di32(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2di32 impure recursive module subroutine from_binaryfile_2di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2di32 impure recursive module subroutine from_textfile_2di16(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2di16 impure recursive module subroutine from_binaryfile_2di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2di16 impure recursive module subroutine from_textfile_2di8(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:), intent(out) :: into logical, intent(in), optional :: header character(len=*), intent(in), optional :: delim character(len=*), intent(in), optional :: fmt end subroutine from_textfile_2di8 impure recursive module subroutine from_binaryfile_2di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binaryfile_2di8 impure recursive module subroutine from_file_3di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3di64 impure recursive module subroutine from_file_3di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3di32 impure recursive module subroutine from_file_3di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3di16 impure recursive module subroutine from_file_3di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_3di8 impure recursive module subroutine from_file_4di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4di64 impure recursive module subroutine from_file_4di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4di32 impure recursive module subroutine from_file_4di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4di16 impure recursive module subroutine from_file_4di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_4di8 impure recursive module subroutine from_file_5di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5di64 impure recursive module subroutine from_file_5di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5di32 impure recursive module subroutine from_file_5di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5di16 impure recursive module subroutine from_file_5di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_5di8 impure recursive module subroutine from_file_6di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6di64 impure recursive module subroutine from_file_6di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6di32 impure recursive module subroutine from_file_6di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6di16 impure recursive module subroutine from_file_6di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_6di8 impure recursive module subroutine from_file_7di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7di64 impure recursive module subroutine from_file_7di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7di32 impure recursive module subroutine from_file_7di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7di16 impure recursive module subroutine from_file_7di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_7di8 impure recursive module subroutine from_file_8di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8di64 impure recursive module subroutine from_file_8di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8di32 impure recursive module subroutine from_file_8di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8di16 impure recursive module subroutine from_file_8di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_8di8 impure recursive module subroutine from_file_9di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9di64 impure recursive module subroutine from_file_9di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9di32 impure recursive module subroutine from_file_9di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9di16 impure recursive module subroutine from_file_9di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_9di8 impure recursive module subroutine from_file_10di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10di64 impure recursive module subroutine from_file_10di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10di32 impure recursive module subroutine from_file_10di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10di16 impure recursive module subroutine from_file_10di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_10di8 impure recursive module subroutine from_file_11di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11di64 impure recursive module subroutine from_file_11di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11di32 impure recursive module subroutine from_file_11di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11di16 impure recursive module subroutine from_file_11di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_11di8 impure recursive module subroutine from_file_12di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12di64 impure recursive module subroutine from_file_12di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12di32 impure recursive module subroutine from_file_12di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12di16 impure recursive module subroutine from_file_12di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_12di8 impure recursive module subroutine from_file_13di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13di64 impure recursive module subroutine from_file_13di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13di32 impure recursive module subroutine from_file_13di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13di16 impure recursive module subroutine from_file_13di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_13di8 impure recursive module subroutine from_file_14di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14di64 impure recursive module subroutine from_file_14di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14di32 impure recursive module subroutine from_file_14di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14di16 impure recursive module subroutine from_file_14di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_14di8 impure recursive module subroutine from_file_15di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15di64 impure recursive module subroutine from_file_15di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15di32 impure recursive module subroutine from_file_15di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15di16 impure recursive module subroutine from_file_15di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_file_15di8 end interface interface echo ! Submodule text_io !-------------------------------------------------------------------------------------------------------------- !! Subroutine for writing a scalar `character` or `String` to an external text file. !! !! The file `file_name` will be created if it does not already exist and will be overwritten if `append` is !! `.false.` (if it already exists). The default terminator is `LF` (line feed). !! !! For a user reference, see [echo](../page/Ref/echo.html). !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine echo_chars(substring, file_name, append, terminator) character(len=*), intent(in) :: substring character(len=*), intent(in) :: file_name logical, intent(in), optional :: append character(len=*), intent(in), optional :: terminator end subroutine echo_chars impure recursive module subroutine echo_string(substring, file_name, append, terminator) class(String), intent(in) :: substring character(len=*), intent(in) :: file_name logical, intent(in), optional :: append character(len=*), intent(in), optional :: terminator end subroutine echo_string end interface interface to_text ! Submodule text_io !! Private interface for writing an array to an external text file. impure recursive module subroutine to_text_1dc128(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_1dc128 impure recursive module subroutine to_text_1dc64(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_1dc64 impure recursive module subroutine to_text_1dc32(x, file_name, header, dim, locale, delim, fmt, decimals, im) complex(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_1dc32 impure recursive module subroutine to_text_2dc128(x, file_name, header, locale, delim, fmt, decimals, im) complex(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_2dc128 impure recursive module subroutine to_text_2dc64(x, file_name, header, locale, delim, fmt, decimals, im) complex(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_2dc64 impure recursive module subroutine to_text_2dc32(x, file_name, header, locale, delim, fmt, decimals, im) complex(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals character(len=*), intent(in) :: im end subroutine to_text_2dc32 impure recursive module subroutine to_text_1dr128(x, file_name, header, dim, locale, delim, fmt, decimals) real(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_1dr128 impure recursive module subroutine to_text_1dr64(x, file_name, header, dim, locale, delim, fmt, decimals) real(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_1dr64 impure recursive module subroutine to_text_1dr32(x, file_name, header, dim, locale, delim, fmt, decimals) real(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_1dr32 impure recursive module subroutine to_text_2dr128(x, file_name, header, locale, delim, fmt, decimals) real(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_2dr128 impure recursive module subroutine to_text_2dr64(x, file_name, header, locale, delim, fmt, decimals) real(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_2dr64 impure recursive module subroutine to_text_2dr32(x, file_name, header, locale, delim, fmt, decimals) real(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt integer, intent(in) :: decimals end subroutine to_text_2dr32 impure recursive module subroutine to_text_1di64(x, file_name, header, dim, delim, fmt) integer(int64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_1di64 impure recursive module subroutine to_text_1di32(x, file_name, header, dim, delim, fmt) integer(int32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_1di32 impure recursive module subroutine to_text_1di16(x, file_name, header, dim, delim, fmt) integer(int16), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_1di16 impure recursive module subroutine to_text_1di8(x, file_name, header, dim, delim, fmt) integer(int8), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header integer, intent(in) :: dim character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_1di8 impure recursive module subroutine to_text_2di64(x, file_name, header, delim, fmt) integer(int64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_2di64 impure recursive module subroutine to_text_2di32(x, file_name, header, delim, fmt) integer(int32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_2di32 impure recursive module subroutine to_text_2di16(x, file_name, header, delim, fmt) integer(int16), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_2di16 impure recursive module subroutine to_text_2di8(x, file_name, header, delim, fmt) integer(int8), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name character(len=*), dimension(:), intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine to_text_2di8 end interface interface from_text ! Submodule text_io !! Private interface for reading an external text file into an array. impure recursive module subroutine from_text_1dc128(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_1dc128 impure recursive module subroutine from_text_1dc64(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_1dc64 impure recursive module subroutine from_text_1dc32(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_1dc32 impure recursive module subroutine from_text_2dc128(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_2dc128 impure recursive module subroutine from_text_2dc64(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_2dc64 impure recursive module subroutine from_text_2dc32(file_name, into, header, locale, delim, fmt, im) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt character(len=*), intent(in) :: im end subroutine from_text_2dc32 impure recursive module subroutine from_text_1dr128(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1dr128 impure recursive module subroutine from_text_1dr64(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1dr64 impure recursive module subroutine from_text_1dr32(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1dr32 impure recursive module subroutine from_text_2dr128(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2dr128 impure recursive module subroutine from_text_2dr64(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2dr64 impure recursive module subroutine from_text_2dr32(file_name, into, header, locale, delim, fmt) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: locale character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2dr32 impure recursive module subroutine from_text_1di64(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1di64 impure recursive module subroutine from_text_1di32(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1di32 impure recursive module subroutine from_text_1di16(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1di16 impure recursive module subroutine from_text_1di8(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_1di8 impure recursive module subroutine from_text_2di64(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2di64 impure recursive module subroutine from_text_2di32(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2di32 impure recursive module subroutine from_text_2di16(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2di16 impure recursive module subroutine from_text_2di8(file_name, into, header, delim, fmt) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:), intent(out) :: into logical, intent(in) :: header character(len=*), intent(in) :: delim character(len=*), intent(in) :: fmt end subroutine from_text_2di8 end interface interface to_binary ! Submodule binary_io !! Private interface for writing an array to an external binary file. impure recursive module subroutine to_binary_1dc128(x, file_name) complex(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dc128 impure recursive module subroutine to_binary_1dc64(x, file_name) complex(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dc64 impure recursive module subroutine to_binary_1dc32(x, file_name) complex(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dc32 impure recursive module subroutine to_binary_2dc128(x, file_name) complex(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dc128 impure recursive module subroutine to_binary_2dc64(x, file_name) complex(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dc64 impure recursive module subroutine to_binary_2dc32(x, file_name) complex(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dc32 impure recursive module subroutine to_binary_3dc128(x, file_name) complex(real128), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dc128 impure recursive module subroutine to_binary_3dc64(x, file_name) complex(real64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dc64 impure recursive module subroutine to_binary_3dc32(x, file_name) complex(real32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dc32 impure recursive module subroutine to_binary_4dc128(x, file_name) complex(real128), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dc128 impure recursive module subroutine to_binary_4dc64(x, file_name) complex(real64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dc64 impure recursive module subroutine to_binary_4dc32(x, file_name) complex(real32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dc32 impure recursive module subroutine to_binary_5dc128(x, file_name) complex(real128), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dc128 impure recursive module subroutine to_binary_5dc64(x, file_name) complex(real64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dc64 impure recursive module subroutine to_binary_5dc32(x, file_name) complex(real32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dc32 impure recursive module subroutine to_binary_6dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dc128 impure recursive module subroutine to_binary_6dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dc64 impure recursive module subroutine to_binary_6dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dc32 impure recursive module subroutine to_binary_7dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dc128 impure recursive module subroutine to_binary_7dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dc64 impure recursive module subroutine to_binary_7dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dc32 impure recursive module subroutine to_binary_8dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dc128 impure recursive module subroutine to_binary_8dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dc64 impure recursive module subroutine to_binary_8dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dc32 impure recursive module subroutine to_binary_9dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dc128 impure recursive module subroutine to_binary_9dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dc64 impure recursive module subroutine to_binary_9dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dc32 impure recursive module subroutine to_binary_10dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dc128 impure recursive module subroutine to_binary_10dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dc64 impure recursive module subroutine to_binary_10dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dc32 impure recursive module subroutine to_binary_11dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dc128 impure recursive module subroutine to_binary_11dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dc64 impure recursive module subroutine to_binary_11dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dc32 impure recursive module subroutine to_binary_12dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dc128 impure recursive module subroutine to_binary_12dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dc64 impure recursive module subroutine to_binary_12dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dc32 impure recursive module subroutine to_binary_13dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dc128 impure recursive module subroutine to_binary_13dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dc64 impure recursive module subroutine to_binary_13dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dc32 impure recursive module subroutine to_binary_14dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dc128 impure recursive module subroutine to_binary_14dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dc64 impure recursive module subroutine to_binary_14dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dc32 impure recursive module subroutine to_binary_15dc128(x, file_name) complex(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dc128 impure recursive module subroutine to_binary_15dc64(x, file_name) complex(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dc64 impure recursive module subroutine to_binary_15dc32(x, file_name) complex(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dc32 impure recursive module subroutine to_binary_1dr128(x, file_name) real(real128), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dr128 impure recursive module subroutine to_binary_1dr64(x, file_name) real(real64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dr64 impure recursive module subroutine to_binary_1dr32(x, file_name) real(real32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1dr32 impure recursive module subroutine to_binary_2dr128(x, file_name) real(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dr128 impure recursive module subroutine to_binary_2dr64(x, file_name) real(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dr64 impure recursive module subroutine to_binary_2dr32(x, file_name) real(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2dr32 impure recursive module subroutine to_binary_3dr128(x, file_name) real(real128), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dr128 impure recursive module subroutine to_binary_3dr64(x, file_name) real(real64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dr64 impure recursive module subroutine to_binary_3dr32(x, file_name) real(real32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3dr32 impure recursive module subroutine to_binary_4dr128(x, file_name) real(real128), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dr128 impure recursive module subroutine to_binary_4dr64(x, file_name) real(real64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dr64 impure recursive module subroutine to_binary_4dr32(x, file_name) real(real32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4dr32 impure recursive module subroutine to_binary_5dr128(x, file_name) real(real128), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dr128 impure recursive module subroutine to_binary_5dr64(x, file_name) real(real64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dr64 impure recursive module subroutine to_binary_5dr32(x, file_name) real(real32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5dr32 impure recursive module subroutine to_binary_6dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dr128 impure recursive module subroutine to_binary_6dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dr64 impure recursive module subroutine to_binary_6dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6dr32 impure recursive module subroutine to_binary_7dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dr128 impure recursive module subroutine to_binary_7dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dr64 impure recursive module subroutine to_binary_7dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7dr32 impure recursive module subroutine to_binary_8dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dr128 impure recursive module subroutine to_binary_8dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dr64 impure recursive module subroutine to_binary_8dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8dr32 impure recursive module subroutine to_binary_9dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dr128 impure recursive module subroutine to_binary_9dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dr64 impure recursive module subroutine to_binary_9dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9dr32 impure recursive module subroutine to_binary_10dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dr128 impure recursive module subroutine to_binary_10dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dr64 impure recursive module subroutine to_binary_10dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10dr32 impure recursive module subroutine to_binary_11dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dr128 impure recursive module subroutine to_binary_11dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dr64 impure recursive module subroutine to_binary_11dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11dr32 impure recursive module subroutine to_binary_12dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dr128 impure recursive module subroutine to_binary_12dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dr64 impure recursive module subroutine to_binary_12dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12dr32 impure recursive module subroutine to_binary_13dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dr128 impure recursive module subroutine to_binary_13dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dr64 impure recursive module subroutine to_binary_13dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13dr32 impure recursive module subroutine to_binary_14dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dr128 impure recursive module subroutine to_binary_14dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dr64 impure recursive module subroutine to_binary_14dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14dr32 impure recursive module subroutine to_binary_15dr128(x, file_name) real(real128), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dr128 impure recursive module subroutine to_binary_15dr64(x, file_name) real(real64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dr64 impure recursive module subroutine to_binary_15dr32(x, file_name) real(real32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15dr32 impure recursive module subroutine to_binary_1di64(x, file_name) integer(int64), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1di64 impure recursive module subroutine to_binary_1di32(x, file_name) integer(int32), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1di32 impure recursive module subroutine to_binary_1di16(x, file_name) integer(int16), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1di16 impure recursive module subroutine to_binary_1di8(x, file_name) integer(int8), dimension(:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_1di8 impure recursive module subroutine to_binary_2di64(x, file_name) integer(int64), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2di64 impure recursive module subroutine to_binary_2di32(x, file_name) integer(int32), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2di32 impure recursive module subroutine to_binary_2di16(x, file_name) integer(int16), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2di16 impure recursive module subroutine to_binary_2di8(x, file_name) integer(int8), dimension(:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_2di8 impure recursive module subroutine to_binary_3di64(x, file_name) integer(int64), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3di64 impure recursive module subroutine to_binary_3di32(x, file_name) integer(int32), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3di32 impure recursive module subroutine to_binary_3di16(x, file_name) integer(int16), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3di16 impure recursive module subroutine to_binary_3di8(x, file_name) integer(int8), dimension(:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_3di8 impure recursive module subroutine to_binary_4di64(x, file_name) integer(int64), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4di64 impure recursive module subroutine to_binary_4di32(x, file_name) integer(int32), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4di32 impure recursive module subroutine to_binary_4di16(x, file_name) integer(int16), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4di16 impure recursive module subroutine to_binary_4di8(x, file_name) integer(int8), dimension(:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_4di8 impure recursive module subroutine to_binary_5di64(x, file_name) integer(int64), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5di64 impure recursive module subroutine to_binary_5di32(x, file_name) integer(int32), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5di32 impure recursive module subroutine to_binary_5di16(x, file_name) integer(int16), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5di16 impure recursive module subroutine to_binary_5di8(x, file_name) integer(int8), dimension(:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_5di8 impure recursive module subroutine to_binary_6di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6di64 impure recursive module subroutine to_binary_6di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6di32 impure recursive module subroutine to_binary_6di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6di16 impure recursive module subroutine to_binary_6di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_6di8 impure recursive module subroutine to_binary_7di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7di64 impure recursive module subroutine to_binary_7di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7di32 impure recursive module subroutine to_binary_7di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7di16 impure recursive module subroutine to_binary_7di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_7di8 impure recursive module subroutine to_binary_8di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8di64 impure recursive module subroutine to_binary_8di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8di32 impure recursive module subroutine to_binary_8di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8di16 impure recursive module subroutine to_binary_8di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_8di8 impure recursive module subroutine to_binary_9di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9di64 impure recursive module subroutine to_binary_9di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9di32 impure recursive module subroutine to_binary_9di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9di16 impure recursive module subroutine to_binary_9di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_9di8 impure recursive module subroutine to_binary_10di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10di64 impure recursive module subroutine to_binary_10di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10di32 impure recursive module subroutine to_binary_10di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10di16 impure recursive module subroutine to_binary_10di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_10di8 impure recursive module subroutine to_binary_11di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11di64 impure recursive module subroutine to_binary_11di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11di32 impure recursive module subroutine to_binary_11di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11di16 impure recursive module subroutine to_binary_11di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_11di8 impure recursive module subroutine to_binary_12di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12di64 impure recursive module subroutine to_binary_12di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12di32 impure recursive module subroutine to_binary_12di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12di16 impure recursive module subroutine to_binary_12di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_12di8 impure recursive module subroutine to_binary_13di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13di64 impure recursive module subroutine to_binary_13di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13di32 impure recursive module subroutine to_binary_13di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13di16 impure recursive module subroutine to_binary_13di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_13di8 impure recursive module subroutine to_binary_14di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14di64 impure recursive module subroutine to_binary_14di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14di32 impure recursive module subroutine to_binary_14di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14di16 impure recursive module subroutine to_binary_14di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_14di8 impure recursive module subroutine to_binary_15di64(x, file_name) integer(int64), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15di64 impure recursive module subroutine to_binary_15di32(x, file_name) integer(int32), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15di32 impure recursive module subroutine to_binary_15di16(x, file_name) integer(int16), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15di16 impure recursive module subroutine to_binary_15di8(x, file_name) integer(int8), dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(in) :: x character(len=*), intent(in) :: file_name end subroutine to_binary_15di8 end interface interface from_binary ! Submodule binary_io !! Private interface for reading an external binary file into an array. impure recursive module subroutine from_binary_1dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dc128 impure recursive module subroutine from_binary_1dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dc64 impure recursive module subroutine from_binary_1dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dc32 impure recursive module subroutine from_binary_2dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dc128 impure recursive module subroutine from_binary_2dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dc64 impure recursive module subroutine from_binary_2dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dc32 impure recursive module subroutine from_binary_3dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dc128 impure recursive module subroutine from_binary_3dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dc64 impure recursive module subroutine from_binary_3dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dc32 impure recursive module subroutine from_binary_4dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dc128 impure recursive module subroutine from_binary_4dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dc64 impure recursive module subroutine from_binary_4dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dc32 impure recursive module subroutine from_binary_5dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dc128 impure recursive module subroutine from_binary_5dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dc64 impure recursive module subroutine from_binary_5dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dc32 impure recursive module subroutine from_binary_6dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dc128 impure recursive module subroutine from_binary_6dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dc64 impure recursive module subroutine from_binary_6dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dc32 impure recursive module subroutine from_binary_7dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dc128 impure recursive module subroutine from_binary_7dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dc64 impure recursive module subroutine from_binary_7dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dc32 impure recursive module subroutine from_binary_8dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dc128 impure recursive module subroutine from_binary_8dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dc64 impure recursive module subroutine from_binary_8dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dc32 impure recursive module subroutine from_binary_9dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dc128 impure recursive module subroutine from_binary_9dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dc64 impure recursive module subroutine from_binary_9dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dc32 impure recursive module subroutine from_binary_10dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dc128 impure recursive module subroutine from_binary_10dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dc64 impure recursive module subroutine from_binary_10dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dc32 impure recursive module subroutine from_binary_11dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dc128 impure recursive module subroutine from_binary_11dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dc64 impure recursive module subroutine from_binary_11dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dc32 impure recursive module subroutine from_binary_12dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dc128 impure recursive module subroutine from_binary_12dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dc64 impure recursive module subroutine from_binary_12dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dc32 impure recursive module subroutine from_binary_13dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dc128 impure recursive module subroutine from_binary_13dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dc64 impure recursive module subroutine from_binary_13dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dc32 impure recursive module subroutine from_binary_14dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dc128 impure recursive module subroutine from_binary_14dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dc64 impure recursive module subroutine from_binary_14dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dc32 impure recursive module subroutine from_binary_15dc128(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dc128 impure recursive module subroutine from_binary_15dc64(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dc64 impure recursive module subroutine from_binary_15dc32(file_name, into, data_shape) character(len=*), intent(in) :: file_name complex(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dc32 impure recursive module subroutine from_binary_1dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dr128 impure recursive module subroutine from_binary_1dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dr64 impure recursive module subroutine from_binary_1dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1dr32 impure recursive module subroutine from_binary_2dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dr128 impure recursive module subroutine from_binary_2dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dr64 impure recursive module subroutine from_binary_2dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2dr32 impure recursive module subroutine from_binary_3dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dr128 impure recursive module subroutine from_binary_3dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dr64 impure recursive module subroutine from_binary_3dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3dr32 impure recursive module subroutine from_binary_4dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dr128 impure recursive module subroutine from_binary_4dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dr64 impure recursive module subroutine from_binary_4dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4dr32 impure recursive module subroutine from_binary_5dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dr128 impure recursive module subroutine from_binary_5dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dr64 impure recursive module subroutine from_binary_5dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5dr32 impure recursive module subroutine from_binary_6dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dr128 impure recursive module subroutine from_binary_6dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dr64 impure recursive module subroutine from_binary_6dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6dr32 impure recursive module subroutine from_binary_7dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dr128 impure recursive module subroutine from_binary_7dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dr64 impure recursive module subroutine from_binary_7dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7dr32 impure recursive module subroutine from_binary_8dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dr128 impure recursive module subroutine from_binary_8dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dr64 impure recursive module subroutine from_binary_8dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8dr32 impure recursive module subroutine from_binary_9dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dr128 impure recursive module subroutine from_binary_9dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dr64 impure recursive module subroutine from_binary_9dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9dr32 impure recursive module subroutine from_binary_10dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dr128 impure recursive module subroutine from_binary_10dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dr64 impure recursive module subroutine from_binary_10dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10dr32 impure recursive module subroutine from_binary_11dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dr128 impure recursive module subroutine from_binary_11dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dr64 impure recursive module subroutine from_binary_11dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11dr32 impure recursive module subroutine from_binary_12dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dr128 impure recursive module subroutine from_binary_12dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dr64 impure recursive module subroutine from_binary_12dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12dr32 impure recursive module subroutine from_binary_13dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dr128 impure recursive module subroutine from_binary_13dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dr64 impure recursive module subroutine from_binary_13dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13dr32 impure recursive module subroutine from_binary_14dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dr128 impure recursive module subroutine from_binary_14dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dr64 impure recursive module subroutine from_binary_14dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14dr32 impure recursive module subroutine from_binary_15dr128(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real128), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dr128 impure recursive module subroutine from_binary_15dr64(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dr64 impure recursive module subroutine from_binary_15dr32(file_name, into, data_shape) character(len=*), intent(in) :: file_name real(real32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15dr32 impure recursive module subroutine from_binary_1di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1di64 impure recursive module subroutine from_binary_1di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1di32 impure recursive module subroutine from_binary_1di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1di16 impure recursive module subroutine from_binary_1di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_1di8 impure recursive module subroutine from_binary_2di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2di64 impure recursive module subroutine from_binary_2di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2di32 impure recursive module subroutine from_binary_2di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2di16 impure recursive module subroutine from_binary_2di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_2di8 impure recursive module subroutine from_binary_3di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3di64 impure recursive module subroutine from_binary_3di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3di32 impure recursive module subroutine from_binary_3di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3di16 impure recursive module subroutine from_binary_3di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_3di8 impure recursive module subroutine from_binary_4di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4di64 impure recursive module subroutine from_binary_4di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4di32 impure recursive module subroutine from_binary_4di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4di16 impure recursive module subroutine from_binary_4di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_4di8 impure recursive module subroutine from_binary_5di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5di64 impure recursive module subroutine from_binary_5di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5di32 impure recursive module subroutine from_binary_5di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5di16 impure recursive module subroutine from_binary_5di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_5di8 impure recursive module subroutine from_binary_6di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6di64 impure recursive module subroutine from_binary_6di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6di32 impure recursive module subroutine from_binary_6di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6di16 impure recursive module subroutine from_binary_6di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_6di8 impure recursive module subroutine from_binary_7di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7di64 impure recursive module subroutine from_binary_7di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7di32 impure recursive module subroutine from_binary_7di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7di16 impure recursive module subroutine from_binary_7di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_7di8 impure recursive module subroutine from_binary_8di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8di64 impure recursive module subroutine from_binary_8di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8di32 impure recursive module subroutine from_binary_8di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8di16 impure recursive module subroutine from_binary_8di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_8di8 impure recursive module subroutine from_binary_9di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9di64 impure recursive module subroutine from_binary_9di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9di32 impure recursive module subroutine from_binary_9di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9di16 impure recursive module subroutine from_binary_9di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_9di8 impure recursive module subroutine from_binary_10di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10di64 impure recursive module subroutine from_binary_10di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10di32 impure recursive module subroutine from_binary_10di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10di16 impure recursive module subroutine from_binary_10di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_10di8 impure recursive module subroutine from_binary_11di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11di64 impure recursive module subroutine from_binary_11di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11di32 impure recursive module subroutine from_binary_11di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11di16 impure recursive module subroutine from_binary_11di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_11di8 impure recursive module subroutine from_binary_12di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12di64 impure recursive module subroutine from_binary_12di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12di32 impure recursive module subroutine from_binary_12di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12di16 impure recursive module subroutine from_binary_12di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_12di8 impure recursive module subroutine from_binary_13di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13di64 impure recursive module subroutine from_binary_13di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13di32 impure recursive module subroutine from_binary_13di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13di16 impure recursive module subroutine from_binary_13di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_13di8 impure recursive module subroutine from_binary_14di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14di64 impure recursive module subroutine from_binary_14di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14di32 impure recursive module subroutine from_binary_14di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14di16 impure recursive module subroutine from_binary_14di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_14di8 impure recursive module subroutine from_binary_15di64(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int64), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15di64 impure recursive module subroutine from_binary_15di32(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int32), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15di32 impure recursive module subroutine from_binary_15di16(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int16), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15di16 impure recursive module subroutine from_binary_15di8(file_name, into, data_shape) character(len=*), intent(in) :: file_name integer(int8), allocatable, dimension(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:), intent(out) :: into integer, dimension(:), intent(in) :: data_shape end subroutine from_binary_15di8 end interface interface aprint ! Submodule array_printing !-------------------------------------------------------------------------------------------------------------- !! Subroutine for printing arrays and array sections to stdout. !! !! For a user reference, see [aprint](../page/Ref/aprint.html). !-------------------------------------------------------------------------------------------------------------- impure recursive module subroutine aprint_1dc128(x, fmt, decimals, im) complex(real128), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_1dc128 impure recursive module subroutine aprint_1dc64(x, fmt, decimals, im) complex(real64), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_1dc64 impure recursive module subroutine aprint_1dc32(x, fmt, decimals, im) complex(real32), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_1dc32 impure recursive module subroutine aprint_2dc128(x, fmt, decimals, im) complex(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_2dc128 impure recursive module subroutine aprint_2dc64(x, fmt, decimals, im) complex(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_2dc64 impure recursive module subroutine aprint_2dc32(x, fmt, decimals, im) complex(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals character(len=*), intent(in), optional :: im end subroutine aprint_2dc32 impure recursive module subroutine aprint_1dr128(x, fmt, decimals) real(real128), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_1dr128 impure recursive module subroutine aprint_1dr64(x, fmt, decimals) real(real64), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_1dr64 impure recursive module subroutine aprint_1dr32(x, fmt, decimals) real(real32), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_1dr32 impure recursive module subroutine aprint_2dr128(x, fmt, decimals) real(real128), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_2dr128 impure recursive module subroutine aprint_2dr64(x, fmt, decimals) real(real64), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_2dr64 impure recursive module subroutine aprint_2dr32(x, fmt, decimals) real(real32), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt integer, intent(in), optional :: decimals end subroutine aprint_2dr32 impure recursive module subroutine aprint_1di64(x, fmt) integer(int64), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_1di64 impure recursive module subroutine aprint_1di32(x, fmt) integer(int32), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_1di32 impure recursive module subroutine aprint_1di16(x, fmt) integer(int16), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_1di16 impure recursive module subroutine aprint_1di8(x, fmt) integer(int8), dimension(:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_1di8 impure recursive module subroutine aprint_2di64(x, fmt) integer(int64), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_2di64 impure recursive module subroutine aprint_2di32(x, fmt) integer(int32), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_2di32 impure recursive module subroutine aprint_2di16(x, fmt) integer(int16), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_2di16 impure recursive module subroutine aprint_2di8(x, fmt) integer(int8), dimension(:,:), intent(in) :: x character(len=*), intent(in), optional :: fmt end subroutine aprint_2di8 impure recursive module subroutine aprint_1dchar(x) character(len=*), dimension(:), intent(in) :: x end subroutine aprint_1dchar impure recursive module subroutine aprint_2dchar(x) character(len=*), dimension(:,:), intent(in) :: x end subroutine aprint_2dchar impure recursive module subroutine aprint_1dString(x) class(String), dimension(:), intent(in) :: x end subroutine aprint_1dString impure recursive module subroutine aprint_2dString(x) class(String), dimension(:,:), intent(in) :: x end subroutine aprint_2dString end interface contains pure recursive function ext_of(file_name) result(ext) ! Function for parsing a file name for an extension character(len=*), intent(in) :: file_name character(len=:), allocatable :: ext integer :: i, l l = len_trim(file_name) do i = l, 1, -1 if ( file_name(i:i) == POINT ) exit end do if ( i > 0 ) then ext = trim(adjustl(file_name(i+1:l))) else ext = EMPTY_STR end if end function ext_of end module io_fortran_lib submodule (io_fortran_lib) String_procedures !! This submodule provides module procedure implementations for the **type-bound procedures** of type `String`. contains module procedure as_str if ( self%len() < 1 ) then string_slice = EMPTY_STR else string_slice = self%s end if end procedure as_str module procedure count_substring_chars integer :: self_len, match_len, i self_len = self%len() match_len = len(match) if ( self_len < 1 ) then if ( self_len == match_len ) then occurrences = 1; return else occurrences = 0; return end if end if if ( (match_len == 0) .or. (match_len > self_len) ) then occurrences = 0; return end if i = 1 occurrences = 0 counting: do while ( i <= self_len ) if ( self%s(i:i) == match(1:1) ) then if ( i+match_len-1 > self_len ) exit counting if ( self%s(i:i+match_len-1) == match ) then occurrences = occurrences + 1 i = i + match_len; cycle counting else i = i + 1; cycle counting end if else i = i + 1; cycle counting end if end do counting end procedure count_substring_chars module procedure count_substring_string integer :: self_len, match_len, i self_len = self%len() match_len = match%len() if ( self_len < 1 ) then if ( self_len == match_len ) then if ( self_len == 0 ) then occurrences = 1; return else occurrences = 0; return end if else occurrences = 0; return end if end if if ( (match_len < 1) .or. (match_len > self_len) ) then occurrences = 0; return end if i = 1 occurrences = 0 counting: do while ( i <= self_len ) if ( self%s(i:i) == match%s(1:1) ) then if ( i+match_len-1 > self_len ) exit counting if ( self%s(i:i+match_len-1) == match%s ) then occurrences = occurrences + 1 i = i + match_len; cycle counting else i = i + 1; cycle counting end if else i = i + 1; cycle counting end if end do counting end procedure count_substring_string module procedure empty self%s = EMPTY_STR end procedure empty module procedure join_into_self type(String), dimension(2) :: token_pair character(len=:), allocatable :: separator_ integer(int64) :: num_tokens type(String) :: comp logical :: GCC num_tokens = size(tokens, kind=int64) if ( num_tokens == 1_int64 ) then if ( tokens(1_int64)%len64() < 1_int64 ) then self%s = EMPTY_STR; return else self%s = tokens(1_int64)%s; return end if end if if ( .not. present(separator) ) then separator_ = SPACE else separator_ = separator end if comp = String(COMPILER); GCC = ( comp%count(match='GCC') > 0 ); deallocate(comp%s) if ( num_tokens > 500_int64 ) then if ( GCC ) then call self%join(tokens=[ join(tokens(:num_tokens/2_int64), separator_), & join(tokens(1_int64+num_tokens/2_int64:), separator_) ], separator=separator_) else call token_pair(1)%join(tokens(:num_tokens/2_int64), separator_) call token_pair(2)%join(tokens(1_int64+num_tokens/2_int64:), separator_) call self%join(tokens=token_pair, separator=separator_) end if else call self%join_base(tokens=tokens, separator=separator_) end if end procedure join_into_self module procedure join_base integer(int64), allocatable, dimension(:) :: lengths, cumm_lengths integer(int64) :: num_tokens, sep_len, total_length, pos, i num_tokens = size(tokens, kind=int64) lengths = tokens%len64() sep_len = len(separator, kind=int64) where ( lengths == -1_int64 ) lengths = 0_int64 total_length = sum(lengths) if ( total_length == 0_int64 ) then self%s = EMPTY_STR; return end if allocate( cumm_lengths(num_tokens), source=1_int64 ) do concurrent (i = 2_int64:num_tokens) cumm_lengths(i) = sum( lengths(:i-1_int64) ) + 1_int64 end do if ( allocated(self%s) ) deallocate(self%s) total_length = total_length + (num_tokens - 1_int64)*sep_len allocate( character(len=total_length) :: self%s ) positional_transfer: do concurrent (i = 1_int64:num_tokens) pos = cumm_lengths(i) + (i - 1_int64)*sep_len if ( lengths(i) > 0_int64 ) then self%s(pos:pos+lengths(i)-1_int64) = tokens(i)%s if ( sep_len > 0_int64 ) then if ( i < num_tokens ) self%s(pos+lengths(i):pos+lengths(i)+sep_len-1_int64) = separator end if else if ( sep_len > 0_int64 ) then if ( i < num_tokens ) self%s(pos:pos+sep_len-1_int64) = separator end if end if end do positional_transfer end procedure join_base module procedure length if ( .not. allocated(self%s) ) then self_len = -1 else self_len = len(self%s) end if end procedure length module procedure length64 if ( .not. allocated(self%s) ) then self_len = -1_int64 else self_len = len(self%s, kind=int64) end if end procedure length64 module procedure push_chars if ( self%len() < 1 ) then self%s = substring else self%s = self%s//substring end if end procedure push_chars module procedure push_string if ( self%len() < 1 ) then if ( substring%len() < 1 ) then self%s = EMPTY_STR else self%s = substring%s end if else if ( substring%len() < 1 ) then return else self%s = self%s//substring%s end if end if end procedure push_string module procedure read_file character(len=:), allocatable :: ext integer(int64) :: file_length integer :: file_unit, iostat logical :: exists ext = ext_of(file_name) if ( .not. any(TEXT_EXT == ext) ) then if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'" in method READ_FILE. Binary data '// & 'cannot be read into a String.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'" in '// & 'method READ_FILE.'// & LF//'Supported file extensions: '//join(TEXT_EXT) end if end if inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if if ( allocated(self%s) ) deallocate(self%s) allocate( character(len=file_length) :: self%s ) read(unit=file_unit, iostat=iostat) self%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if if ( .not. present(cell_array) ) then if ( present(row_separator) ) then write(*,'(a)') LF//'WARNING: Row separator was specified in method READ_FILE for file "'// & file_name//'" without a cell array output. To use this option, '// & 'provide an actual argument to cell_array.' end if if ( present(column_separator) ) then write(*,'(a)') LF//'WARNING: Column separator was specified in method READ_FILE for file "'// & file_name//'" without a cell array output. To use this option, '// & 'provide an actual argument to cell_array.' end if return end if if ( present(row_separator) ) then if ( len(row_separator) == 0 ) then write(*,'(a)') LF//'WARNING: Cannot populate a cell array with the contents of file "'// & file_name//'" using an empty row separator. Returning without cell array...' return end if end if if ( present(column_separator) ) then if ( len(column_separator) == 0 ) then write(*,'(a)') LF//'WARNING: Cannot populate a cell array with the contents of file "'// & file_name//'" using an empty column separator. Returning without cell array...' return end if end if cell_block: block type(String), allocatable, dimension(:) :: rows, columns character(len=:), allocatable :: row_separator_, column_separator_ integer(int64) :: n_rows, n_cols, i logical, allocatable, dimension(:) :: quotes_exist if ( .not. present(row_separator) ) then row_separator_ = LF else row_separator_ = row_separator end if if ( .not. present(column_separator) ) then column_separator_ = COMMA else column_separator_ = column_separator end if ! rows = self%split(separator=row_separator_) call split_because_ifxbug(self, separator=row_separator_, tokens=rows) if ( rows(size(rows, kind=int64))%len64() < 1_int64 ) then n_rows = size(rows, kind=int64) - 1_int64 else n_rows = size(rows, kind=int64) end if allocate( quotes_exist(n_rows), source=.false. ) call process_quotes(rows(:n_rows), column_separator=column_separator_, quotes_exist=quotes_exist) ! columns = rows(1_int64)%split(separator=column_separator_) call split_because_ifxbug(rows(1_int64), separator=column_separator_, tokens=columns) n_cols = size(columns, kind=int64) allocate( cell_array(n_rows, n_cols) ) cell_array(1_int64,:) = columns; call scrub(columns); deallocate(columns) do concurrent (i = 2_int64:n_rows) ! cell_array(i,:) = rows(i)%split(separator=column_separator_) call split_because_ifxbug(rows(i),separator=column_separator_,tokens=columns); cell_array(i,:)=columns end do call scrub(rows); deallocate(rows) if ( allocated(columns) ) then call scrub(columns); deallocate(columns) end if do concurrent (i = 1_int64:n_rows) if ( quotes_exist(i) ) call re_process_quotes(cell_array(i,:), column_separator=column_separator_) end do end block cell_block contains pure elemental recursive subroutine process_quotes(row, column_separator, quotes_exist) type(String), intent(inout) :: row character(len=*), intent(in) :: column_separator logical, intent(inout) :: quotes_exist character(len=:), allocatable :: replacement logical :: in_quote integer(int64) :: sep_len, i sep_len = len(column_separator, kind=int64) if ( sep_len == 1_int64 ) then replacement = NUL else replacement = repeat(NUL, ncopies=sep_len) end if i = 1_int64 in_quote = .false. replace_sep: do while ( i <= row%len64()-sep_len+1_int64 ) if ( row%s(i:i) == QQUOTE ) then in_quote = ( .not. in_quote ) if ( .not. quotes_exist ) quotes_exist = .true. i = i + 1_int64; cycle replace_sep end if if ( in_quote ) then if ( row%s(i:i+sep_len-1_int64) == column_separator ) then row%s(i:i+sep_len-1_int64) = replacement i = i + sep_len; cycle replace_sep else i = i + 1_int64; cycle replace_sep end if else i = i + 1_int64; cycle replace_sep end if end do replace_sep end subroutine process_quotes pure elemental recursive subroutine re_process_quotes(cell, column_separator) type(String), intent(inout) :: cell character(len=*), intent(in) :: column_separator character(len=:), allocatable :: replacement logical :: in_quote integer(int64) :: sep_len, i sep_len = len(column_separator, kind=int64) if ( sep_len == 1_int64 ) then replacement = NUL else replacement = repeat(NUL, ncopies=sep_len) end if i = 1_int64 in_quote = .false. replace_sep: do while ( i <= cell%len64()-sep_len+1_int64 ) if ( cell%s(i:i) == QQUOTE ) then in_quote = ( .not. in_quote ) i = i + 1_int64; cycle replace_sep end if if ( in_quote ) then if ( cell%s(i:i+sep_len-1_int64) == replacement ) then cell%s(i:i+sep_len-1_int64) = column_separator i = i + sep_len; cycle replace_sep else i = i + 1_int64; cycle replace_sep end if else i = i + 1_int64; cycle replace_sep end if end do replace_sep end subroutine re_process_quotes pure recursive subroutine split_because_ifxbug(substring, separator, tokens) ! This subroutine exists purely as a workaround for an ifx 2023.0.0 bug resulting in a ! segmentation fault on an assignment of the form tokens = substring%split(separator). ! This procedure is a copy of split_string. class(String), intent(in) :: substring character(len=*), intent(in) :: separator type(String), allocatable, dimension(:), intent(out) :: tokens integer(int64) :: substring_len, sep_len, num_seps, i integer(int64), allocatable, dimension(:) :: sep_positions substring_len = substring%len64() if ( substring_len < 1_int64 ) then allocate( tokens(1) ); tokens(1)%s = EMPTY_STR; return end if sep_len = len(separator, kind=int64) num_seps = 0_int64 i = 1_int64 allocate( sep_positions(substring_len) ) count_seps: do while ( i <= substring_len-sep_len+1_int64 ) if ( substring%s(i:i+sep_len-1_int64) == separator ) then num_seps = num_seps + 1_int64; sep_positions(num_seps) = i i = i + sep_len; cycle count_seps else i = i + 1_int64; cycle count_seps end if end do count_seps if ( num_seps == 0_int64 ) then allocate( tokens(1) ); tokens(1)%s = substring%s; return end if allocate( tokens(num_seps + 1_int64) ) positional_transfers: do concurrent (i = 1:num_seps) if ( i == 1_int64 ) then if ( sep_positions(i) == 1_int64 ) then tokens(i)%s = EMPTY_STR else tokens(i)%s = substring%s(1_int64:sep_positions(i)-1_int64) end if else if ( sep_positions(i) == sep_positions(i-1_int64)+sep_len ) then tokens(i)%s = EMPTY_STR else tokens(i)%s = substring%s(sep_positions(i-1_int64)+sep_len:sep_positions(i)-1_int64) end if end if if ( i == num_seps ) then if ( sep_positions(i)+sep_len > substring_len ) then tokens(i+1_int64)%s = EMPTY_STR else tokens(i+1_int64)%s = substring%s(sep_positions(i)+sep_len:) end if end if end do positional_transfers end subroutine split_because_ifxbug end procedure read_file module procedure replace_ch_copy integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = len(match) substring_len = len(substring) if ( self_len < 1 ) then new%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) then new%s = self%s; return end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match ) then new%s = new%s(:i-1+diff_len)//substring//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match ) then new%s = new%s(:i-match_len)//substring//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if end procedure replace_ch_copy module procedure replace_st_copy character(len=:), allocatable :: substring_ integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = match%len() substring_len = substring%len() if ( self_len < 1 ) then new%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) then new%s = self%s; return end if if ( substring_len < 1 ) then substring_ = EMPTY_STR else substring_ = substring%s end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match%s(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match%s ) then new%s = new%s(:i-1+diff_len)//substring_//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match%s(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match%s ) then new%s = new%s(:i-match_len)//substring_//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if end procedure replace_st_copy module procedure replace_chst_copy character(len=:), allocatable :: substring_ integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = len(match) substring_len = substring%len() if ( self_len < 1 ) then new%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) then new%s = self%s; return end if if ( substring_len < 1 ) then substring_ = EMPTY_STR else substring_ = substring%s end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match ) then new%s = new%s(:i-1+diff_len)//substring_//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match ) then new%s = new%s(:i-match_len)//substring_//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if end procedure replace_chst_copy module procedure replace_stch_copy integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = match%len() substring_len = len(substring) if ( self_len < 1 ) then new%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) then new%s = self%s; return end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match%s(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match%s ) then new%s = new%s(:i-1+diff_len)//substring//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match%s(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match%s ) then new%s = new%s(:i-match_len)//substring//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if end procedure replace_stch_copy module procedure replace_ch_inplace type(String) :: new integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = len(match) substring_len = len(substring) if ( self_len < 1 ) then self%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) return if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match ) then new%s = new%s(:i-1+diff_len)//substring//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match ) then new%s = new%s(:i-match_len)//substring//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if self%s = new%s end procedure replace_ch_inplace module procedure replace_st_inplace type(String) :: new character(len=:), allocatable :: substring_ integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = match%len() substring_len = substring%len() if ( self_len < 1 ) then self%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) return if ( substring_len < 1 ) then substring_ = EMPTY_STR else substring_ = substring%s end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match%s(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match%s ) then new%s = new%s(:i-1+diff_len)//substring_//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match%s(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match%s ) then new%s = new%s(:i-match_len)//substring_//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if self%s = new%s end procedure replace_st_inplace module procedure replace_chst_inplace type(String) :: new character(len=:), allocatable :: substring_ integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = len(match) substring_len = substring%len() if ( self_len < 1 ) then self%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) return if ( substring_len < 1 ) then substring_ = EMPTY_STR else substring_ = substring%s end if if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match ) then new%s = new%s(:i-1+diff_len)//substring_//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match ) then new%s = new%s(:i-match_len)//substring_//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if self%s = new%s end procedure replace_chst_inplace module procedure replace_stch_inplace type(String) :: new integer :: i, self_len, match_len, substring_len, diff_len logical :: back_ self_len = self%len() match_len = match%len() substring_len = len(substring) if ( self_len < 1 ) then self%s = EMPTY_STR; return end if if ( (match_len < 1) .or. (match_len > self_len) ) return if ( .not. present(back) ) then back_ = .false. else back_ = back end if new%s = self%s if ( .not. back_ ) then i = 1; diff_len = 0 match_and_replace_forward: do while ( i <= self_len ) if ( self%s(i:i) == match%s(1:1) ) then if ( i+match_len-1 > self_len ) exit match_and_replace_forward if ( self%s(i:i+match_len-1) == match%s ) then new%s = new%s(:i-1+diff_len)//substring//new%s(i+match_len+diff_len:) diff_len = diff_len + ( substring_len - match_len ) i = i + match_len; cycle match_and_replace_forward else i = i + 1; cycle match_and_replace_forward end if else i = i + 1; cycle match_and_replace_forward end if end do match_and_replace_forward else i = self_len match_and_replace_backward: do while ( i > 0 ) if ( self%s(i:i) == match%s(match_len:match_len) ) then if ( i-match_len+1 < 1 ) exit match_and_replace_backward if ( self%s(i-match_len+1:i) == match%s ) then new%s = new%s(:i-match_len)//substring//new%s(i+1:) i = i - match_len; cycle match_and_replace_backward else i = i - 1; cycle match_and_replace_backward end if else i = i - 1; cycle match_and_replace_backward end if end do match_and_replace_backward end if self%s = new%s end procedure replace_stch_inplace module procedure trim_copy if ( self%len() < 1 ) then new%s = EMPTY_STR else new%s = trim(adjustl(self%s)) end if end procedure trim_copy module procedure trim_inplace if ( self%len() < 1 ) then self%s = EMPTY_STR else self%s = trim(adjustl(self%s)) end if end procedure trim_inplace module procedure write_file type(String), allocatable, dimension(:) :: rows character(len=:), allocatable :: ext, row_separator_, column_separator_ integer(int64) :: n_rows, i logical :: exists, append_ integer :: file_unit ext = ext_of(file_name) if ( .not. any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" in method WRITE_FILE'// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT) return end if if ( .not. present(row_separator) ) then row_separator_ = LF else row_separator_ = row_separator end if if ( .not. present(column_separator) ) then column_separator_ = COMMA else column_separator_ = column_separator end if if ( .not. present(append) ) then append_ = .false. else append_ = append end if n_rows = size(cell_array, dim=1, kind=int64) allocate( rows(n_rows) ) do concurrent (i = 1_int64:n_rows) rows(i) = join(tokens=cell_array(i,:), separator=column_separator_)//row_separator_ end do call scrub(cell_array) call self%join(tokens=rows, separator=EMPTY_STR) call scrub(rows); deallocate(rows) inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else if ( .not. append_ ) then open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='write', access='stream', position='append' ) end if end if write( unit=file_unit ) self%s close(file_unit) end procedure write_file module procedure write_string if ( substring%len() < 1 ) then write(unit=unit, fmt='(a)', iostat=iostat, iomsg=iomsg) EMPTY_STR else write(unit=unit, fmt='(a)', iostat=iostat, iomsg=iomsg) substring%s end if end procedure write_string module procedure scrub if ( allocated(self%s) ) deallocate(self%s) end procedure scrub end submodule String_procedures submodule (io_fortran_lib) operators !! This submodule provides module procedure implementations for the **public interfaces** `operator(//)`, !! `operator(+)`, `operator(-)`, `operator(**)`, `operator(==)`, and `operator(/=)`. contains module procedure string_concatenation if ( Stringl%len() < 1 ) then if ( Stringr%len() < 1 ) then new%s = EMPTY_STR; return else new%s = Stringr%s; return end if end if if ( Stringr%len() < 1 ) then new%s = Stringl%s; return end if new%s = Stringl%s//Stringr%s end procedure string_concatenation module procedure string_char_concatenation if ( Stringl%len() < 1 ) then if ( len(charsr) < 1 ) then new%s = EMPTY_STR; return else new%s = charsr; return end if end if if ( len(charsr) < 1 ) then new%s = Stringl%s; return end if new%s = Stringl%s//charsr end procedure string_char_concatenation module procedure char_string_concatenation if ( len(charsl) < 1 ) then if ( Stringr%len() < 1 ) then new%s = EMPTY_STR; return else new%s = Stringr%s; return end if end if if ( Stringr%len() < 1 ) then new%s = charsl; return end if new%s = charsl//Stringr%s end procedure char_string_concatenation module procedure char_concat_plus new = charsl//charsr end procedure char_concat_plus module procedure string_concat_plus if ( Stringl%len() < 1 ) then if ( Stringr%len() < 1 ) then new%s = EMPTY_STR; return else new%s = Stringr%s; return end if end if if ( Stringr%len() < 1 ) then new%s = Stringl%s; return end if new%s = Stringl%s//Stringr%s end procedure string_concat_plus module procedure string_char_concat_plus if ( Stringl%len() < 1 ) then if ( len(charsr) < 1 ) then new%s = EMPTY_STR; return else new%s = charsr; return end if end if if ( len(charsr) < 1 ) then new%s = Stringl%s; return end if new%s = Stringl%s//charsr end procedure string_char_concat_plus module procedure char_string_concat_plus if ( len(charsl) < 1 ) then if ( Stringr%len() < 1 ) then new%s = EMPTY_STR; return else new%s = Stringr%s; return end if end if if ( Stringr%len() < 1 ) then new%s = charsl; return end if new%s = charsl//Stringr%s end procedure char_string_concat_plus module procedure char_excision type(String) :: Stringl Stringl%s = charsl if ( Stringl%len() < 1 ) then new%s = EMPTY_STR; return end if if ( len(charsr) < 1 ) then new%s = Stringl%s; return end if new = Stringl%replace(match=charsr, substring=EMPTY_STR) end procedure char_excision module procedure string_excision if ( Stringl%len() < 1 ) then new%s = EMPTY_STR; return end if if ( Stringr%len() < 1 ) then new%s = Stringl%s; return end if new = Stringl%replace(match=Stringr%s, substring=EMPTY_STR) end procedure string_excision module procedure string_char_excision if ( Stringl%len() < 1 ) then new%s = EMPTY_STR; return end if if ( len(charsr) < 1 ) then new%s = Stringl%s; return end if new = Stringl%replace(match=charsr, substring=EMPTY_STR) end procedure string_char_excision module procedure char_string_excision type(String) :: Stringl Stringl%s = charsl if ( Stringl%len() < 1 ) then new%s = EMPTY_STR; return end if if ( Stringr%len() < 1 ) then new%s = Stringl%s; return end if new = Stringl%replace(match=Stringr%s, substring=EMPTY_STR) end procedure char_string_excision module procedure repeat_chars new = repeat(char_base, ncopies=ncopies) end procedure repeat_chars module procedure repeat_String if ( String_base%len() < 1 ) then new%s = EMPTY_STR; return end if new%s = repeat(String_base%s, ncopies=ncopies) end procedure repeat_String module procedure string_equivalence integer :: Stringl_len, Stringr_len Stringl_len = Stringl%len() Stringr_len = Stringr%len() if ( Stringl_len /= Stringr_len ) then equal = .false.; return end if if ( Stringl_len < 1 ) then equal = .true.; return end if equal = ( Stringl%s == Stringr%s ) end procedure string_equivalence module procedure string_char_equivalence integer :: Stringl_len, charsr_len Stringl_len = Stringl%len() charsr_len = len(charsr) if ( Stringl_len /= charsr_len ) then equal = .false.; return end if if ( Stringl_len < 1 ) then equal = .true.; return end if equal = ( Stringl%s == charsr ) end procedure string_char_equivalence module procedure char_string_equivalence integer :: charsl_len, Stringr_len charsl_len = len(charsl) Stringr_len = Stringr%len() if ( charsl_len /= Stringr_len ) then equal = .false.; return end if if ( charsl_len < 1 ) then equal = .true.; return end if equal = ( charsl == Stringr%s ) end procedure char_string_equivalence module procedure string_nonequivalence integer :: Stringl_len, Stringr_len Stringl_len = Stringl%len() Stringr_len = Stringr%len() if ( Stringl_len /= Stringr_len ) then unequal = .true.; return end if if ( Stringl_len < 1 ) then unequal = .false.; return end if unequal = ( Stringl%s /= Stringr%s ) end procedure string_nonequivalence module procedure string_char_nonequivalence integer :: Stringl_len, charsr_len Stringl_len = Stringl%len() charsr_len = len(charsr) if ( Stringl_len /= charsr_len ) then unequal = .true.; return end if if ( Stringl_len < 1 ) then unequal = .false.; return end if unequal = ( Stringl%s /= charsr ) end procedure string_char_nonequivalence module procedure char_string_nonequivalence integer :: charsl_len, Stringr_len charsl_len = len(charsl) Stringr_len = Stringr%len() if ( charsl_len /= Stringr_len ) then unequal = .true.; return end if if ( charsl_len < 1 ) then unequal = .false.; return end if unequal = ( charsl /= Stringr%s ) end procedure char_string_nonequivalence end submodule operators submodule (io_fortran_lib) internal_io !! This submodule provides module procedure implementations for the **public interfaces** `String`, `str`, and !! `cast`. contains module procedure new_Str_c128 character(len=1) :: fmt_ character(len=:), allocatable :: decimal, xre_str, xim_str, im_ integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re /= 0.0_real128 ) then allocate( character(len=34) :: xre_str ) else xre_str = '0x0'; exit if_z_re end if write(unit=xre_str(3:), fmt='(z32)') x%re do concurrent (i = 3:34) if ( (xre_str(i:i) >= 'A') .and. (xre_str(i:i) <= 'F') ) xre_str(i:i) = achar(iachar(xre_str(i:i))+32) end do xre_str(1:2) = '0x'; exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im /= 0.0_real128 ) then allocate( character(len=34) :: xim_str ) else xim_str = '0x0'; exit if_z_im end if write(unit=xim_str(3:), fmt='(z32)') x%im do concurrent (i = 3:34) if ( (xim_str(i:i) >= 'A') .and. (xim_str(i:i) <= 'F') ) xim_str(i:i) = achar(iachar(xim_str(i:i))+32) end do xim_str(1:2) = '0x'; exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real128 ) then xre_str = '0.0e+0000'; exit if_eorf_re end if if ( x%re < 0.0_real128 ) then allocate( character(len=44) :: xre_str ) write(unit=xre_str, fmt='(es44.35e4)', decimal=decimal) x%re do i = 44, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do else allocate( character(len=43) :: xre_str ) write(unit=xre_str, fmt='(es43.35e4)', decimal=decimal) x%re do i = 43, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 35 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 43 if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+36:); exit if_eorf_re end if end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real128 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.36)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.100)', decimal=decimal) x%re end if i = 1 do while ( i <= 125 ) if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:125) = xre_str(i:124); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( decimals >= 36-e ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real128 ) then xim_str = '0.0e+0000'; exit if_eorf_im end if if ( x%im < 0.0_real128 ) then allocate( character(len=44) :: xim_str ) write(unit=xim_str, fmt='(es44.35e4)', decimal=decimal) x%im do i = 44, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do else allocate( character(len=43) :: xim_str ) write(unit=xim_str, fmt='(es43.35e4)', decimal=decimal) x%im do i = 43, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 35 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 43 if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+36:); exit if_eorf_im end if end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real128 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.36)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.100)', decimal=decimal) x%im end if i = 1 do while ( i <= 125 ) if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:125) = xim_str(i:124); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( decimals >= 36-e ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then new%s = '('//xre_str//COMMA//xim_str//')'; return else new%s = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then new%s = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real128 ) then new%s = xre_str//xim_str//im_ else new%s = xre_str//'+'//xim_str//im_ end if end procedure new_Str_c128 module procedure new_Str_c64 character(len=1) :: fmt_ character(len=:), allocatable :: decimal, xre_str, xim_str, im_ integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real64 ) then xre_str = '0x0'; exit if_z_re end if xre_str = str( transfer(source=x%re, mold=1_int64), fmt='z' ); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real64 ) then xim_str = '0x0'; exit if_z_im end if xim_str = str( transfer(source=x%im, mold=1_int64), fmt='z' ); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real64 ) then xre_str = '0.0e+000'; exit if_eorf_re end if if ( x%re < 0.0_real64 ) then allocate( character(len=25) :: xre_str ) write(unit=xre_str, fmt='(es25.17e3)', decimal=decimal) x%re do i = 25, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do else allocate( character(len=24) :: xre_str ) write(unit=xre_str, fmt='(es24.17e3)', decimal=decimal) x%re do i = 24, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 17 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 24 if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+18:); exit if_eorf_re end if end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real64 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.18)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.80)', decimal=decimal) x%re end if i = 1 do while ( i <= 100 ) if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:100) = xre_str(i:99); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( decimals >= 18-e ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real64 ) then xim_str = '0.0e+000'; exit if_eorf_im end if if ( x%im < 0.0_real64 ) then allocate( character(len=25) :: xim_str ) write(unit=xim_str, fmt='(es25.17e3)', decimal=decimal) x%im do i = 25, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do else allocate( character(len=24) :: xim_str ) write(unit=xim_str, fmt='(es24.17e3)', decimal=decimal) x%im do i = 24, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 17 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 24 if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+18:); exit if_eorf_im end if end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real64 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.18)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.80)', decimal=decimal) x%im end if i = 1 do while ( i <= 100 ) if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:100) = xim_str(i:99); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( decimals >= 18-e ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then new%s = '('//xre_str//COMMA//xim_str//')'; return else new%s = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then new%s = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real64 ) then new%s = xre_str//xim_str//im_ else new%s = xre_str//'+'//xim_str//im_ end if end procedure new_Str_c64 module procedure new_Str_c32 character(len=1) :: fmt_ character(len=:), allocatable :: decimal, xre_str, xim_str, im_ integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real32 ) then xre_str = '0x0'; exit if_z_re end if xre_str = str( transfer(source=x%re, mold=1_int32), fmt='z' ); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real32 ) then xim_str = '0x0'; exit if_z_im end if xim_str = str( transfer(source=x%im, mold=1_int32), fmt='z' ); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real32 ) then xre_str = '0.0e+00'; exit if_eorf_re end if if ( x%re < 0.0_real32 ) then allocate( character(len=15) :: xre_str ) write(unit=xre_str, fmt='(es15.8e2)', decimal=decimal) x%re do i = 15, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do else allocate( character(len=14) :: xre_str ) write(unit=xre_str, fmt='(es14.8e2)', decimal=decimal) x%re do i = 14, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 8 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 14 if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+9:); exit if_eorf_re end if end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real32 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.9)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.70)', decimal=decimal) x%re end if i = 1 do while ( i <= 75 ) if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:75) = xre_str(i:74); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( decimals >= 9-e ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real32 ) then xim_str = '0.0e+00'; exit if_eorf_im end if if ( x%im < 0.0_real32 ) then allocate( character(len=15) :: xim_str ) write(unit=xim_str, fmt='(es15.8e2)', decimal=decimal) x%im do i = 15, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do else allocate( character(len=14) :: xim_str ) write(unit=xim_str, fmt='(es14.8e2)', decimal=decimal) x%im do i = 14, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 8 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 14 if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+9:); exit if_eorf_im end if end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real32 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.9)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.70)', decimal=decimal) x%im end if i = 1 do while ( i <= 75 ) if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:75) = xim_str(i:74); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( decimals >= 9-e ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then new%s = '('//xre_str//COMMA//xim_str//')'; return else new%s = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then new%s = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real32 ) then new%s = xre_str//xim_str//im_ else new%s = xre_str//'+'//xim_str//im_ end if end procedure new_Str_c32 module procedure new_Str_r128 character(len=1) :: fmt_ character(len=:), allocatable :: decimal integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x /= 0.0_real128 ) then allocate( character(len=34) :: new%s ) else new%s = '0x0'; return end if write(unit=new%s(3:), fmt='(z32)') x do concurrent (i = 3:34) if ( (new%s(i:i) >= 'A') .and. (new%s(i:i) <= 'F') ) new%s(i:i) = achar(iachar(new%s(i:i)) + 32) end do new%s(1:2) = '0x'; return end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real128 ) then new%s = '0.0e+0000'; return end if if ( x < 0.0_real128 ) then allocate( character(len=44) :: new%s ) write(unit=new%s, fmt='(es44.35e4)', decimal=decimal) x do i = 44, 1, -1 if ( new%s(i:i) == 'E' ) then new%s(i:i) = 'e'; exit end if end do else allocate( character(len=43) :: new%s ) write(unit=new%s, fmt='(es43.35e4)', decimal=decimal) x do i = 43, 1, -1 if ( new%s(i:i) == 'E' ) then new%s(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) return if ( decimals >= 35 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 43 if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) then new%s = new%s(:i+decimals_)//new%s(i+36:); return end if end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real128 ) then e = int(log10(abs(x))) else new%s = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: new%s ) if ( e > 0 ) then write(unit=new%s, fmt='(f0.36)', decimal=decimal) x else write(unit=new%s, fmt='(f0.100)', decimal=decimal) x end if i = 1 do while ( i <= 125 ) if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (new%s(1:1) == '-') ) ) then new%s(i+1:125) = new%s(i:124); new%s(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then new%s = new%s(:i)//'0'; return end if if ( .not. present(decimals) ) then new%s = new%s(:i+36-e); return end if if ( decimals <= 0 ) then new%s = new%s(:i)//'0'; return end if if ( decimals >= 36-e ) then new%s = new%s(:i+36-e); return end if new%s = new%s(:i+decimals); return end if end procedure new_Str_r128 module procedure new_Str_r64 character(len=1) :: fmt_ character(len=:), allocatable :: decimal integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real64 ) then new%s = '0x0'; return end if inline_str_i64: block; integer(int64) :: x_int, num; logical :: negative; integer :: num_len, i x_int = transfer(source=x, mold=x_int) if ( x_int < 0 ) then num_len = 1; num = (x_int + 1_int64) + huge(1_int64); negative = .true. else num_len = 1; num = x_int; negative = .false. end if count_hex_digits: do num = num/16 if ( num > 0 ) then num_len = num_len + 1; cycle count_hex_digits else exit count_hex_digits end if end do count_hex_digits if ( negative ) then num = (x_int + 1_int64) + huge(1_int64) new%s = '0x0000000000000000' else num = x_int allocate( character(len=2+num_len) :: new%s ); new%s(1:2) = '0x' end if insert_hex_characters: do i = len(new%s), len(new%s)-num_len+1, -1 new%s(i:i) = DIGITS_A( mod(num,16) ); num = num/16 end do insert_hex_characters if ( negative ) then i = 0; do if ( DIGITS_A(i) == new%s(3:3) ) exit i = i + 1; cycle end do new%s(3:3) = DIGITS_A(i+8); return else return end if end block inline_str_i64 end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real64 ) then new%s = '0.0e+000'; return end if if ( x < 0.0_real64 ) then allocate( character(len=25) :: new%s ) write(unit=new%s, fmt='(es25.17e3)', decimal=decimal) x do i = 25, 1, -1 if ( new%s(i:i) == 'E' ) then new%s(i:i) = 'e'; exit end if end do else allocate( character(len=24) :: new%s ) write(unit=new%s, fmt='(es24.17e3)', decimal=decimal) x do i = 24, 1, -1 if ( new%s(i:i) == 'E' ) then new%s(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) return if ( decimals >= 17 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 24 if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) then new%s = new%s(:i+decimals_)//new%s(i+18:); return end if end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real64 ) then e = int(log10(abs(x))) else new%s = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: new%s ) if ( e > 0 ) then write(unit=new%s, fmt='(f0.18)', decimal=decimal) x else write(unit=new%s, fmt='(f0.80)', decimal=decimal) x end if i = 1 do while ( i <= 100 ) if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (new%s(1:1) == '-') ) ) then new%s(i+1:100) = new%s(i:99); new%s(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then new%s = new%s(:i)//'0'; return end if if ( .not. present(decimals) ) then new%s = new%s(:i+18-e); return end if if ( decimals <= 0 ) then new%s = new%s(:i)//'0'; return end if if ( decimals >= 18-e ) then new%s = new%s(:i+18-e); return end if new%s = new%s(:i+decimals); return end if end procedure new_Str_r64 module procedure new_Str_r32 character(len=1) :: fmt_ character(len=:), allocatable :: decimal integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real32 ) then new%s = '0x0'; return end if inline_str_i32: block; integer(int32) :: x_int, num; logical :: negative; integer :: num_len, i x_int = transfer(source=x, mold=x_int) if ( x_int < 0 ) then num_len = 1; num = (x_int + 1_int32) + huge(1_int32); negative = .true. else num_len = 1; num = x_int; negative = .false. end if count_hex_digits: do num = num/16 if ( num > 0 ) then num_len = num_len + 1; cycle count_hex_digits else exit count_hex_digits end if end do count_hex_digits if ( negative ) then num = (x_int + 1_int32) + huge(1_int32) new%s = '0x00000000' else num = x_int allocate( character(len=2+num_len) :: new%s ); new%s(1:2) = '0x' end if insert_hex_characters: do i = len(new%s), len(new%s)-num_len+1, -1 new%s(i:i) = DIGITS_A( mod(num,16) ); num = num/16 end do insert_hex_characters if ( negative ) then i = 0; do if ( DIGITS_A(i) == new%s(3:3) ) exit i = i + 1; cycle end do new%s(3:3) = DIGITS_A(i+8); return else return end if end block inline_str_i32 end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real32 ) then new%s = '0.0e+00'; return end if if ( x < 0.0_real32 ) then allocate( character(len=15) :: new%s ) write(unit=new%s, fmt='(es15.8e2)', decimal=decimal) x do i = 15, 1, -1 if ( new%s(i:i) == 'E' ) then new%s(i:i) = 'e'; exit end if end do else allocate( character(len=14) :: new%s ) write(unit=new%s, fmt='(es14.8e2)', decimal=decimal) x do i = 14, 1, -1 if ( new%s(i:i) == 'E' ) then new%s(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) return if ( decimals >= 8 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 14 if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) then new%s = new%s(:i+decimals_)//new%s(i+9:); return end if end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real32 ) then e = int(log10(abs(x))) else new%s = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: new%s ) if ( e > 0 ) then write(unit=new%s, fmt='(f0.9)', decimal=decimal) x else write(unit=new%s, fmt='(f0.70)', decimal=decimal) x end if i = 1 do while ( i <= 75 ) if ( (new%s(i:i) == POINT) .or. (new%s(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (new%s(1:1) == '-') ) ) then new%s(i+1:75) = new%s(i:74); new%s(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then new%s = new%s(:i)//'0'; return end if if ( .not. present(decimals) ) then new%s = new%s(:i+9-e); return end if if ( decimals <= 0 ) then new%s = new%s(:i)//'0'; return end if if ( decimals >= 9-e ) then new%s = new%s(:i+9-e); return end if new%s = new%s(:i+decimals); return end if end procedure new_Str_r32 module procedure new_Str_i64 character(len=1) :: fmt_ integer(int64) :: num logical :: negative integer :: num_len, i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == -huge(1_int64)-1_int64 ) then new%s = '-9223372036854775808'; return end if num_len = 2; num = abs(x); negative = .true. else num_len = 1; num = x; negative = .false. end if count_digits: do num = num/10 if ( num > 0 ) then num_len = num_len + 1; cycle count_digits else exit count_digits end if end do count_digits allocate( character(len=num_len) :: new%s ) if ( negative ) then num = abs(x) do i = num_len, 2, -1 new%s(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do new%s(1:1) = '-'; return else num = x do i = num_len, 1, -1 new%s(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do return end if else if ( fmt_ == 'z' ) then if ( x < 0 ) then num_len = 1; num = (x + 1_int64) + huge(1_int64); negative = .true. else num_len = 1; num = x; negative = .false. end if count_hex_digits: do num = num/16 if ( num > 0 ) then num_len = num_len + 1; cycle count_hex_digits else exit count_hex_digits end if end do count_hex_digits if ( negative ) then num = (x + 1_int64) + huge(1_int64) new%s = '0x0000000000000000' else num = x allocate( character(len=2+num_len) :: new%s ); new%s(1:2) = '0x' end if insert_hex_characters: do i = len(new%s), len(new%s)-num_len+1, -1 new%s(i:i) = DIGITS_A( mod(num,16) ); num = num/16 end do insert_hex_characters if ( negative ) then i = 0; do if ( DIGITS_A(i) == new%s(3:3) ) exit i = i + 1; cycle end do new%s(3:3) = DIGITS_A(i+8); return else return end if end if end procedure new_Str_i64 module procedure new_Str_i32 character(len=1) :: fmt_ integer(int32) :: num logical :: negative integer :: num_len, i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == -huge(1_int32)-1_int32 ) then new%s = '-2147483648'; return end if num_len = 2; num = abs(x); negative = .true. else num_len = 1; num = x; negative = .false. end if count_digits: do num = num/10 if ( num > 0 ) then num_len = num_len + 1; cycle count_digits else exit count_digits end if end do count_digits allocate( character(len=num_len) :: new%s ) if ( negative ) then num = abs(x) do i = num_len, 2, -1 new%s(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do new%s(1:1) = '-'; return else num = x do i = num_len, 1, -1 new%s(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do return end if else if ( fmt_ == 'z' ) then if ( x < 0 ) then num_len = 1; num = (x + 1_int32) + huge(1_int32); negative = .true. else num_len = 1; num = x; negative = .false. end if count_hex_digits: do num = num/16 if ( num > 0 ) then num_len = num_len + 1; cycle count_hex_digits else exit count_hex_digits end if end do count_hex_digits if ( negative ) then num = (x + 1_int32) + huge(1_int32) new%s = '0x00000000' else num = x allocate( character(len=2+num_len) :: new%s ); new%s(1:2) = '0x' end if insert_hex_characters: do i = len(new%s), len(new%s)-num_len+1, -1 new%s(i:i) = DIGITS_A( mod(num,16) ); num = num/16 end do insert_hex_characters if ( negative ) then i = 0; do if ( DIGITS_A(i) == new%s(3:3) ) exit i = i + 1; cycle end do new%s(3:3) = DIGITS_A(i+8); return else return end if end if end procedure new_Str_i32 module procedure new_Str_i16 character(len=1) :: fmt_ integer(int16) :: num logical :: negative integer :: num_len, i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == -huge(1_int16)-1_int16 ) then new%s = '-32768'; return end if num_len = 2; num = abs(x); negative = .true. else num_len = 1; num = x; negative = .false. end if count_digits: do num = num/10 if ( num > 0 ) then num_len = num_len + 1; cycle count_digits else exit count_digits end if end do count_digits allocate( character(len=num_len) :: new%s ) if ( negative ) then num = abs(x) do i = num_len, 2, -1 new%s(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do new%s(1:1) = '-'; return else num = x do i = num_len, 1, -1 new%s(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do return end if else if ( fmt_ == 'z' ) then if ( x < 0 ) then num_len = 1; num = (x + 1_int16) + huge(1_int16); negative = .true. else num_len = 1; num = x; negative = .false. end if count_hex_digits: do num = num/16 if ( num > 0 ) then num_len = num_len + 1; cycle count_hex_digits else exit count_hex_digits end if end do count_hex_digits if ( negative ) then num = (x + 1_int16) + huge(1_int16) new%s = '0x0000' else num = x allocate( character(len=2+num_len) :: new%s ); new%s(1:2) = '0x' end if insert_hex_characters: do i = len(new%s), len(new%s)-num_len+1, -1 new%s(i:i) = DIGITS_A( mod(num,16) ); num = num/16 end do insert_hex_characters if ( negative ) then i = 0; do if ( DIGITS_A(i) == new%s(3:3) ) exit i = i + 1; cycle end do new%s(3:3) = DIGITS_A(i+8); return else return end if end if end procedure new_Str_i16 module procedure new_Str_i8 character(len=1) :: fmt_ integer(int8) :: num logical :: negative integer :: num_len, i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else new%s = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == -huge(1_int8)-1_int8 ) then new%s = '-128'; return end if num_len = 2; num = abs(x); negative = .true. else num_len = 1; num = x; negative = .false. end if count_digits: do num = num/10 if ( num > 0 ) then num_len = num_len + 1; cycle count_digits else exit count_digits end if end do count_digits allocate( character(len=num_len) :: new%s ) if ( negative ) then num = abs(x) do i = num_len, 2, -1 new%s(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do new%s(1:1) = '-'; return else num = x do i = num_len, 1, -1 new%s(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do return end if else if ( fmt_ == 'z' ) then if ( x < 0 ) then num_len = 1; num = (x + 1_int8) + huge(1_int8); negative = .true. else num_len = 1; num = x; negative = .false. end if count_hex_digits: do num = num/16 if ( num > 0 ) then num_len = num_len + 1; cycle count_hex_digits else exit count_hex_digits end if end do count_hex_digits if ( negative ) then num = (x + 1_int8) + huge(1_int8) new%s = '0x00' else num = x allocate( character(len=2+num_len) :: new%s ); new%s(1:2) = '0x' end if insert_hex_characters: do i = len(new%s), len(new%s)-num_len+1, -1 new%s(i:i) = DIGITS_A( mod(num,16) ); num = num/16 end do insert_hex_characters if ( negative ) then i = 0; do if ( DIGITS_A(i) == new%s(3:3) ) exit i = i + 1; cycle end do new%s(3:3) = DIGITS_A(i+8); return end if else return end if end procedure new_Str_i8 module procedure new_Str_string if ( x%len() < 1 ) then new%s = EMPTY_STR else new%s = x%s end if end procedure new_Str_string module procedure new_Str_char new%s = x end procedure new_Str_char module procedure new_Str_empty new%s = EMPTY_STR end procedure new_Str_empty module procedure cast_string_c128 character(len=1) :: fmt_ character(len=:), allocatable :: im_, decimal character(len=:), allocatable, dimension(:) :: seps, e_chars real(real128) :: z_re, z_im integer, allocatable :: substring_len, i, l, r, im_len substring_len = substring%len() if ( substring_len < 1 ) then into = (0.0_real128,0.0_real128); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real128,0.0_real128); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real128,0.0_real128); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then seps = [ COMMA ] else seps = [ SEMICOLON ] end if l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) == '(' ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= 1 ) if ( substring%s(r:r) == ')' ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( substring%s(i:i) == seps(1) ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then if ( i-l-1 > 2 ) then if ( substring%s(l+1:l+2) == '0x' ) then read(unit=substring%s(l+3:i-1), fmt='(z100)') z_re else read(unit=substring%s(l+1:i-1), fmt='(z100)') z_re end if else read(unit=substring%s(l+1:i-1), fmt='(z100)') z_re end if if ( r-i-1 > 2 ) then if ( substring%s(i+1:i+2) == '0x' ) then read(unit=substring%s(i+3:r-1), fmt='(z100)') z_im else read(unit=substring%s(i+1:r-1), fmt='(z100)') z_im end if else read(unit=substring%s(i+1:r-1), fmt='(z100)') z_im end if into = cmplx(z_re, z_im, kind=real128); return else read(unit=substring%s(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real128); return end if end if im_len = len(im_); seps = [ '+', '-' ]; e_chars = [ 'e', 'E' ] l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do while ( r >= 1 ) if ( substring%s(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( any(seps == substring%s(i:i)) ) then if ( any(e_chars == substring%s(i-1:i-1)) .and. (fmt_ /= 'z') ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do if ( fmt_ == 'z' ) then if ( i-l > 2 ) then if ( substring%s(l:l+1) == '0x' ) then read(unit=substring%s(l+2:i-1), fmt='(z100)') z_re else read(unit=substring%s(l:i-1), fmt='(z100)') z_re end if else read(unit=substring%s(l:i-1), fmt='(z100)') z_re end if if ( r-i-1 > 2 ) then if ( substring%s(i+1:i+2) == '0x' ) then read(unit=substring%s(i+3:r-1), fmt='(z100)') z_im else read(unit=substring%s(i+1:r-1), fmt='(z100)') z_im end if else read(unit=substring%s(i+1:r-1), fmt='(z100)') z_im end if into = cmplx(z_re, z_im, kind=real128); return else read(unit=substring%s(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real128); return end if end procedure cast_string_c128 module procedure cast_string_c64 character(len=1) :: fmt_ character(len=:), allocatable :: im_, decimal character(len=:), allocatable, dimension(:) :: seps, e_chars real(real64) :: z_re, z_im integer, allocatable :: substring_len, i, l, r, im_len substring_len = substring%len() if ( substring_len < 1 ) then into = (0.0_real64,0.0_real64); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real64,0.0_real64); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real64,0.0_real64); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then seps = [ COMMA ] else seps = [ SEMICOLON ] end if l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) == '(' ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= 1 ) if ( substring%s(r:r) == ')' ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( substring%s(i:i) == seps(1) ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer(int64) :: num; character(len=:), allocatable :: hex_str hex_str = substring%s(l+1:i-1) call cast(hex_str, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) hex_str = substring%s(i+1:r-1) call cast(hex_str, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real64); return end block else read(unit=substring%s(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real64); return end if end if im_len = len(im_); seps = [ '+', '-' ]; e_chars = [ 'e', 'E' ] l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do while ( r >= 1 ) if ( substring%s(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( any(seps == substring%s(i:i)) ) then if ( any(e_chars == substring%s(i-1:i-1)) .and. (fmt_ /= 'z') ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer(int64) :: num; character(len=:), allocatable :: hex_str hex_str = substring%s(l:i-1) call cast(hex_str, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) hex_str = substring%s(i+1:r-1) call cast(hex_str, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real64); return end block else read(unit=substring%s(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real64); return end if end procedure cast_string_c64 module procedure cast_string_c32 character(len=1) :: fmt_ character(len=:), allocatable :: im_, decimal character(len=:), allocatable, dimension(:) :: seps, e_chars real(real32) :: z_re, z_im integer, allocatable :: substring_len, i, l, r, im_len substring_len = substring%len() if ( substring_len < 1 ) then into = (0.0_real32,0.0_real32); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real32,0.0_real32); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real32,0.0_real32); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then seps = [ COMMA ] else seps = [ SEMICOLON ] end if l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) == '(' ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= 1 ) if ( substring%s(r:r) == ')' ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( substring%s(i:i) == seps(1) ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer(int32) :: num; character(len=:), allocatable :: hex_str hex_str = substring%s(l+1:i-1) call cast(hex_str, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) hex_str = substring%s(i+1:r-1) call cast(hex_str, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real32); return end block else read(unit=substring%s(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real32); return end if end if im_len = len(im_); seps = [ '+', '-' ]; e_chars = [ 'e', 'E' ] l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do while ( r >= 1 ) if ( substring%s(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( any(seps == substring%s(i:i)) ) then if ( any(e_chars == substring%s(i-1:i-1)) .and. (fmt_ /= 'z') ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer(int32) :: num; character(len=:), allocatable :: hex_str hex_str = substring%s(l:i-1) call cast(hex_str, into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) hex_str = substring%s(i+1:r-1) call cast(hex_str, into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real32); return end block else read(unit=substring%s(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring%s(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real32); return end if end procedure cast_string_c32 module procedure cast_string_r128 character(len=1) :: fmt_ character(len=:), allocatable :: decimal if ( substring%len() < 1 ) then into = 0.0_real128; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real128; return end if end if if ( fmt_ == 'z' ) then if ( substring%len() > 2 ) then if ( substring%s(1:2) == '0x' ) then read(unit=substring%s(3:), fmt='(z100)') into; return else read(unit=substring%s, fmt='(z100)') into; return end if else read(unit=substring%s, fmt='(z100)') into; return end if end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real128; return end if end if read(unit=substring%s, fmt=*, decimal=decimal) into end procedure cast_string_r128 module procedure cast_string_r64 character(len=1) :: fmt_ character(len=:), allocatable :: decimal if ( substring%len() < 1 ) then into = 0.0_real64; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real64; return end if end if if ( fmt_ == 'z' ) then inline_cast_i64: block; integer(int64) :: num, i; logical :: negative; integer :: substring_len, l, r, j substring_len = substring%len() l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do if ( substring_len > 2 ) then if ( substring%s(l:l+1) == '0x' ) l = l + 2 end if r = substring_len; do while ( r >= l ) if ( substring%s(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( r-l+1 == 16 ) then j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(l:l) ) exit j = j + 1; cycle end do if ( j >= 8 ) then negative = .true. else negative = .false. end if else negative = .false. end if num = 0_int64 i = 1_int64; do j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(r:r) ) exit j = j + 1; cycle end do if ( r > l ) then num = num + i*int(DIGITS_I(j), kind=int64) else if ( r == l ) then if ( negative ) then num = num + i*int(DIGITS_I(j-8), kind=int64); num = (num - 1_int64) - huge(1_int64) into = transfer(source=num, mold=into); return else num = num + i*int(DIGITS_I(j), kind=int64) into = transfer(source=num, mold=into); return end if end if i = 16_int64*i; r = r - 1; cycle end do end block inline_cast_i64 end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real64; return end if end if read(unit=substring%s, fmt=*, decimal=decimal) into end procedure cast_string_r64 module procedure cast_string_r32 character(len=1) :: fmt_ character(len=:), allocatable :: decimal if ( substring%len() < 1 ) then into = 0.0_real32; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real32; return end if end if if ( fmt_ == 'z' ) then inline_cast_i32: block; integer(int32) :: num, i; logical :: negative; integer :: substring_len, l, r, j substring_len = substring%len() l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do if ( substring_len > 2 ) then if ( substring%s(l:l+1) == '0x' ) l = l + 2 end if r = substring_len; do while ( r >= l ) if ( substring%s(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( r-l+1 == 8 ) then j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(l:l) ) exit j = j + 1; cycle end do if ( j >= 8 ) then negative = .true. else negative = .false. end if else negative = .false. end if num = 0_int32 i = 1_int32; do j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(r:r) ) exit j = j + 1; cycle end do if ( r > l ) then num = num + i*DIGITS_I(j) else if ( r == l ) then if ( negative ) then num = num + i*DIGITS_I(j-8); num = (num - 1_int32) - huge(1_int32) into = transfer(source=num, mold=into); return else num = num + i*DIGITS_I(j) into = transfer(source=num, mold=into); return end if end if i = 16_int32*i; r = r - 1; cycle end do end block inline_cast_i32 end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real32; return end if end if read(unit=substring%s, fmt=*, decimal=decimal) into end procedure cast_string_r32 module procedure cast_string_i64 character(len=1) :: fmt_ logical :: negative integer :: substring_len, l, r, j integer(int64) :: i substring_len = substring%len() if ( substring_len < 1 ) then into = 0_int64; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int64; return end if end if if ( fmt_ == 'i' ) then l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= l ) if ( substring%s(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( substring%s(l:l) == '-' ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int64 i = 1_int64; do j = 0; do while ( j <= 9 ) if ( DIGITS_A(j) == substring%s(r:r) ) exit j = j + 1; cycle end do into = into + i*int(DIGITS_I(j), kind=int64) if ( r == l ) exit i = 10_int64*i; r = r - 1; cycle end do if ( negative ) then into = -into; return else return end if else if ( fmt_ == 'z' ) then l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do if ( substring_len > 2 ) then if ( substring%s(l:l+1) == '0x' ) l = l + 2 end if r = substring_len; do while ( r >= l ) if ( substring%s(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( r-l+1 == 16 ) then j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(l:l) ) exit j = j + 1; cycle end do if ( j >= 8 ) then negative = .true. else negative = .false. end if else negative = .false. end if into = 0_int64 i = 1_int64; do j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(r:r) ) exit j = j + 1; cycle end do if ( r > l ) then into = into + i*int(DIGITS_I(j), kind=int64) else if ( r == l ) then if ( negative ) then into = into + i*int(DIGITS_I(j-8), kind=int64); into = (into - 1_int64) - huge(1_int64); return else into = into + i*int(DIGITS_I(j), kind=int64); return end if end if i = 16_int64*i; r = r - 1; cycle end do end if end procedure cast_string_i64 module procedure cast_string_i32 character(len=1) :: fmt_ logical :: negative integer :: substring_len, l, r, j integer(int32) :: i substring_len = substring%len() if ( substring_len < 1 ) then into = 0_int32; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int32; return end if end if if ( fmt_ == 'i' ) then l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= l ) if ( substring%s(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( substring%s(l:l) == '-' ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int32 i = 1_int32; do j = 0; do while ( j <= 9 ) if ( DIGITS_A(j) == substring%s(r:r) ) exit j = j + 1; cycle end do into = into + i*DIGITS_I(j) if ( r == l ) exit i = 10_int32*i; r = r - 1; cycle end do if ( negative ) then into = -into; return else return end if else if ( fmt_ == 'z' ) then l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do if ( substring_len > 2 ) then if ( substring%s(l:l+1) == '0x' ) l = l + 2 end if r = substring_len; do while ( r >= l ) if ( substring%s(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( r-l+1 == 8 ) then j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(l:l) ) exit j = j + 1; cycle end do if ( j >= 8 ) then negative = .true. else negative = .false. end if else negative = .false. end if into = 0_int32 i = 1_int32; do j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(r:r) ) exit j = j + 1; cycle end do if ( r > l ) then into = into + i*DIGITS_I(j) else if ( r == l ) then if ( negative ) then into = into + i*DIGITS_I(j-8); into = (into - 1_int32) - huge(1_int32); return else into = into + i*DIGITS_I(j); return end if end if i = 16_int32*i; r = r - 1; cycle end do end if end procedure cast_string_i32 module procedure cast_string_i16 character(len=1) :: fmt_ logical :: negative integer :: substring_len, l, r, j integer(int16) :: i substring_len = substring%len() if ( substring_len < 1 ) then into = 0_int16; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int16; return end if end if if ( fmt_ == 'i' ) then l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= l ) if ( substring%s(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( substring%s(l:l) == '-' ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int16 i = 1_int16; do j = 0; do while ( j <= 9 ) if ( DIGITS_A(j) == substring%s(r:r) ) exit j = j + 1; cycle end do into = into + i*int(DIGITS_I(j), kind=int16) if ( r == l ) exit i = 10_int16*i; r = r - 1; cycle end do if ( negative ) then into = -into; return else return end if else if ( fmt_ == 'z' ) then l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do if ( substring_len > 2 ) then if ( substring%s(l:l+1) == '0x' ) l = l + 2 end if r = substring_len; do while ( r >= l ) if ( substring%s(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( r-l+1 == 4 ) then j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(l:l) ) exit j = j + 1; cycle end do if ( j >= 8 ) then negative = .true. else negative = .false. end if else negative = .false. end if into = 0_int16 i = 1_int16; do j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(r:r) ) exit j = j + 1; cycle end do if ( r > l ) then into = into + i*int(DIGITS_I(j), kind=int16) else if ( r == l ) then if ( negative ) then into = into + i*int(DIGITS_I(j-8), kind=int16); into = (into - 1_int16) - huge(1_int16); return else into = into + i*int(DIGITS_I(j), kind=int16); return end if end if i = 16_int16*i; r = r - 1; cycle end do end if end procedure cast_string_i16 module procedure cast_string_i8 character(len=1) :: fmt_ logical :: negative integer :: substring_len, l, r, j integer(int8) :: i substring_len = substring%len() if ( substring_len < 1 ) then into = 0_int8; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int8; return end if end if if ( fmt_ == 'i' ) then l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= l ) if ( substring%s(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( substring%s(l:l) == '-' ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int8 i = 1_int8; do j = 0; do while ( j <= 9 ) if ( DIGITS_A(j) == substring%s(r:r) ) exit j = j + 1; cycle end do into = into + i*int(DIGITS_I(j), kind=int8) if ( r == l ) exit i = 10_int8*i; r = r - 1; cycle end do if ( negative ) then into = -into; return else return end if else if ( fmt_ == 'z' ) then l = 1; do while ( l <= substring_len ) if ( substring%s(l:l) /= SPACE ) exit l = l + 1; cycle end do if ( substring_len > 2 ) then if ( substring%s(l:l+1) == '0x' ) l = l + 2 end if r = substring_len; do while ( r >= l ) if ( substring%s(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( r-l+1 == 2 ) then j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(l:l) ) exit j = j + 1; cycle end do if ( j >= 8 ) then negative = .true. else negative = .false. end if else negative = .false. end if into = 0_int8 i = 1_int8; do j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring%s(r:r) ) exit j = j + 1; cycle end do if ( r > l ) then into = into + i*int(DIGITS_I(j), kind=int8) else if ( r == l ) then if ( negative ) then into = into + i*int(DIGITS_I(j-8), kind=int8); into = (into - 1_int8) - huge(1_int8); return else into = into + i*int(DIGITS_I(j), kind=int8); return end if end if i = 16_int8*i; r = r - 1; cycle end do end if end procedure cast_string_i8 module procedure str_c128 character(len=1) :: fmt_ character(len=:), allocatable :: decimal, xre_str, xim_str, im_ integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re /= 0.0_real128 ) then allocate( character(len=34) :: xre_str ) else xre_str = '0x0'; exit if_z_re end if write(unit=xre_str(3:), fmt='(z32)') x%re do concurrent (i = 3:34) if ( (xre_str(i:i) >= 'A') .and. (xre_str(i:i) <= 'F') ) xre_str(i:i) = achar(iachar(xre_str(i:i))+32) end do xre_str(1:2) = '0x'; exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im /= 0.0_real128 ) then allocate( character(len=34) :: xim_str ) else xim_str = '0x0'; exit if_z_im end if write(unit=xim_str(3:), fmt='(z32)') x%im do concurrent (i = 3:34) if ( (xim_str(i:i) >= 'A') .and. (xim_str(i:i) <= 'F') ) xim_str(i:i) = achar(iachar(xim_str(i:i))+32) end do xim_str(1:2) = '0x'; exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real128 ) then xre_str = '0.0e+0000'; exit if_eorf_re end if if ( x%re < 0.0_real128 ) then allocate( character(len=44) :: xre_str ) write(unit=xre_str, fmt='(es44.35e4)', decimal=decimal) x%re do i = 44, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do else allocate( character(len=43) :: xre_str ) write(unit=xre_str, fmt='(es43.35e4)', decimal=decimal) x%re do i = 43, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 35 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 43 if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+36:); exit if_eorf_re end if end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real128 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.36)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.100)', decimal=decimal) x%re end if i = 1 do while ( i <= 125 ) if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:125) = xre_str(i:124); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( decimals >= 36-e ) then xre_str = xre_str(:i+36-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real128 ) then xim_str = '0.0e+0000'; exit if_eorf_im end if if ( x%im < 0.0_real128 ) then allocate( character(len=44) :: xim_str ) write(unit=xim_str, fmt='(es44.35e4)', decimal=decimal) x%im do i = 44, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do else allocate( character(len=43) :: xim_str ) write(unit=xim_str, fmt='(es43.35e4)', decimal=decimal) x%im do i = 43, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 35 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 43 if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+36:); exit if_eorf_im end if end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real128 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.36)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.100)', decimal=decimal) x%im end if i = 1 do while ( i <= 125 ) if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:125) = xim_str(i:124); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( decimals >= 36-e ) then xim_str = xim_str(:i+36-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then x_str = '('//xre_str//COMMA//xim_str//')'; return else x_str = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then x_str = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real128 ) then x_str = xre_str//xim_str//im_ else x_str = xre_str//'+'//xim_str//im_ end if end procedure str_c128 module procedure str_c64 character(len=1) :: fmt_ character(len=:), allocatable :: decimal, xre_str, xim_str, im_ integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real64 ) then xre_str = '0x0'; exit if_z_re end if xre_str = str( transfer(source=x%re, mold=1_int64), fmt='z' ); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real64 ) then xim_str = '0x0'; exit if_z_im end if xim_str = str( transfer(source=x%im, mold=1_int64), fmt='z' ); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real64 ) then xre_str = '0.0e+000'; exit if_eorf_re end if if ( x%re < 0.0_real64 ) then allocate( character(len=25) :: xre_str ) write(unit=xre_str, fmt='(es25.17e3)', decimal=decimal) x%re do i = 25, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do else allocate( character(len=24) :: xre_str ) write(unit=xre_str, fmt='(es24.17e3)', decimal=decimal) x%re do i = 24, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 17 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 24 if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+18:); exit if_eorf_re end if end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real64 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.18)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.80)', decimal=decimal) x%re end if i = 1 do while ( i <= 100 ) if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:100) = xre_str(i:99); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( decimals >= 18-e ) then xre_str = xre_str(:i+18-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real64 ) then xim_str = '0.0e+000'; exit if_eorf_im end if if ( x%im < 0.0_real64 ) then allocate( character(len=25) :: xim_str ) write(unit=xim_str, fmt='(es25.17e3)', decimal=decimal) x%im do i = 25, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do else allocate( character(len=24) :: xim_str ) write(unit=xim_str, fmt='(es24.17e3)', decimal=decimal) x%im do i = 24, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 17 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 24 if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+18:); exit if_eorf_im end if end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real64 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.18)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.80)', decimal=decimal) x%im end if i = 1 do while ( i <= 100 ) if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:100) = xim_str(i:99); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( decimals >= 18-e ) then xim_str = xim_str(:i+18-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then x_str = '('//xre_str//COMMA//xim_str//')'; return else x_str = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then x_str = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real64 ) then x_str = xre_str//xim_str//im_ else x_str = xre_str//'+'//xim_str//im_ end if end procedure str_c64 module procedure str_c32 character(len=1) :: fmt_ character(len=:), allocatable :: decimal, xre_str, xim_str, im_ integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if_z_re: if ( fmt_ == 'z' ) then if ( x%re == 0.0_real32 ) then xre_str = '0x0'; exit if_z_re end if xre_str = str( transfer(source=x%re, mold=1_int32), fmt='z' ); exit if_z_re end if if_z_re if_z_im: if ( fmt_ == 'z' ) then if ( x%im == 0.0_real32 ) then xim_str = '0x0'; exit if_z_im end if xim_str = str( transfer(source=x%im, mold=1_int32), fmt='z' ); exit if_z_im end if if_z_im if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if_eorf_re: if ( fmt_ == 'e' ) then if ( x%re == 0.0_real32 ) then xre_str = '0.0e+00'; exit if_eorf_re end if if ( x%re < 0.0_real32 ) then allocate( character(len=15) :: xre_str ) write(unit=xre_str, fmt='(es15.8e2)', decimal=decimal) x%re do i = 15, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do else allocate( character(len=14) :: xre_str ) write(unit=xre_str, fmt='(es14.8e2)', decimal=decimal) x%re do i = 14, 1, -1 if ( xre_str(i:i) == 'E' ) then xre_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_re if ( decimals >= 8 ) exit if_eorf_re if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 14 if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) then xre_str = xre_str(:i+decimals_)//xre_str(i+9:); exit if_eorf_re end if end do else if ( fmt_ == 'f' ) then if ( abs(x%re) /= 0.0_real32 ) then e = int(log10(abs(x%re))) else xre_str = '0.0'; exit if_eorf_re end if if ( e == 0 ) then if ( floor(x%re) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xre_str ) if ( e > 0 ) then write(unit=xre_str, fmt='(f0.9)', decimal=decimal) x%re else write(unit=xre_str, fmt='(f0.70)', decimal=decimal) x%re end if i = 1 do while ( i <= 75 ) if ( (xre_str(i:i) == POINT) .or. (xre_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xre_str(1:1) == '-') ) ) then xre_str(i+1:75) = xre_str(i:74); xre_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( .not. present(decimals) ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if if ( decimals <= 0 ) then xre_str = xre_str(:i)//'0'; exit if_eorf_re end if if ( decimals >= 9-e ) then xre_str = xre_str(:i+9-e); exit if_eorf_re end if xre_str = xre_str(:i+decimals); exit if_eorf_re end if if_eorf_re if_eorf_im: if ( fmt_ == 'e' ) then if ( x%im == 0.0_real32 ) then xim_str = '0.0e+00'; exit if_eorf_im end if if ( x%im < 0.0_real32 ) then allocate( character(len=15) :: xim_str ) write(unit=xim_str, fmt='(es15.8e2)', decimal=decimal) x%im do i = 15, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do else allocate( character(len=14) :: xim_str ) write(unit=xim_str, fmt='(es14.8e2)', decimal=decimal) x%im do i = 14, 1, -1 if ( xim_str(i:i) == 'E' ) then xim_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) exit if_eorf_im if ( decimals >= 8 ) exit if_eorf_im if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 14 if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) then xim_str = xim_str(:i+decimals_)//xim_str(i+9:); exit if_eorf_im end if end do else if ( fmt_ == 'f' ) then if ( abs(x%im) /= 0.0_real32 ) then e = int(log10(abs(x%im))) else xim_str = '0.0'; exit if_eorf_im end if if ( e == 0 ) then if ( floor(x%im) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: xim_str ) if ( e > 0 ) then write(unit=xim_str, fmt='(f0.9)', decimal=decimal) x%im else write(unit=xim_str, fmt='(f0.70)', decimal=decimal) x%im end if i = 1 do while ( i <= 75 ) if ( (xim_str(i:i) == POINT) .or. (xim_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (xim_str(1:1) == '-') ) ) then xim_str(i+1:75) = xim_str(i:74); xim_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( .not. present(decimals) ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if if ( decimals <= 0 ) then xim_str = xim_str(:i)//'0'; exit if_eorf_im end if if ( decimals >= 9-e ) then xim_str = xim_str(:i+9-e); exit if_eorf_im end if xim_str = xim_str(:i+decimals); exit if_eorf_im end if if_eorf_im if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( im_ == EMPTY_STR ) then if ( decimal == 'POINT' ) then x_str = '('//xre_str//COMMA//xim_str//')'; return else x_str = '('//xre_str//SEMICOLON//xim_str//')'; return end if end if if ( fmt_ == 'z' ) then x_str = xre_str//'+'//xim_str//im_; return end if if ( x%im < 0.0_real32 ) then x_str = xre_str//xim_str//im_ else x_str = xre_str//'+'//xim_str//im_ end if end procedure str_c32 module procedure str_r128 character(len=1) :: fmt_ character(len=:), allocatable :: decimal integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x /= 0.0_real128 ) then allocate( character(len=34) :: x_str ) else x_str = '0x0'; return end if write(unit=x_str(3:), fmt='(z32)') x do concurrent (i = 3:34) if ( (x_str(i:i) >= 'A') .and. (x_str(i:i) <= 'F') ) x_str(i:i) = achar(iachar(x_str(i:i)) + 32) end do x_str(1:2) = '0x'; return end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real128 ) then x_str = '0.0e+0000'; return end if if ( x < 0.0_real128 ) then allocate( character(len=44) :: x_str ) write(unit=x_str, fmt='(es44.35e4)', decimal=decimal) x do i = 44, 1, -1 if ( x_str(i:i) == 'E' ) then x_str(i:i) = 'e'; exit end if end do else allocate( character(len=43) :: x_str ) write(unit=x_str, fmt='(es43.35e4)', decimal=decimal) x do i = 43, 1, -1 if ( x_str(i:i) == 'E' ) then x_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) return if ( decimals >= 35 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 43 if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) then x_str = x_str(:i+decimals_)//x_str(i+36:); return end if end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real128 ) then e = int(log10(abs(x))) else x_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=125) :: x_str ) if ( e > 0 ) then write(unit=x_str, fmt='(f0.36)', decimal=decimal) x else write(unit=x_str, fmt='(f0.100)', decimal=decimal) x end if i = 1 do while ( i <= 125 ) if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (x_str(1:1) == '-') ) ) then x_str(i+1:125) = x_str(i:124); x_str(i:i) = '0'; i = i + 1 end if if ( i > 36 ) then x_str = x_str(:i)//'0'; return end if if ( .not. present(decimals) ) then x_str = x_str(:i+36-e); return end if if ( decimals <= 0 ) then x_str = x_str(:i)//'0'; return end if if ( decimals >= 36-e ) then x_str = x_str(:i+36-e); return end if x_str = x_str(:i+decimals); return end if end procedure str_r128 module procedure str_r64 character(len=1) :: fmt_ character(len=:), allocatable :: decimal integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real64 ) then x_str = '0x0'; return end if x_str = str( transfer(source=x, mold=1_int64), fmt='z' ); return end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real64 ) then x_str = '0.0e+000'; return end if if ( x < 0.0_real64 ) then allocate( character(len=25) :: x_str ) write(unit=x_str, fmt='(es25.17e3)', decimal=decimal) x do i = 25, 1, -1 if ( x_str(i:i) == 'E' ) then x_str(i:i) = 'e'; exit end if end do else allocate( character(len=24) :: x_str ) write(unit=x_str, fmt='(es24.17e3)', decimal=decimal) x do i = 24, 1, -1 if ( x_str(i:i) == 'E' ) then x_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) return if ( decimals >= 17 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 24 if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) then x_str = x_str(:i+decimals_)//x_str(i+18:); return end if end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real64 ) then e = int(log10(abs(x))) else x_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=100) :: x_str ) if ( e > 0 ) then write(unit=x_str, fmt='(f0.18)', decimal=decimal) x else write(unit=x_str, fmt='(f0.80)', decimal=decimal) x end if i = 1 do while ( i <= 100 ) if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (x_str(1:1) == '-') ) ) then x_str(i+1:100) = x_str(i:99); x_str(i:i) = '0'; i = i + 1 end if if ( i > 18 ) then x_str = x_str(:i)//'0'; return end if if ( .not. present(decimals) ) then x_str = x_str(:i+18-e); return end if if ( decimals <= 0 ) then x_str = x_str(:i)//'0'; return end if if ( decimals >= 18-e ) then x_str = x_str(:i+18-e); return end if x_str = x_str(:i+decimals); return end if end procedure str_r64 module procedure str_r32 character(len=1) :: fmt_ character(len=:), allocatable :: decimal integer, allocatable :: e, decimals_ integer :: i if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'z' ) then if ( x == 0.0_real32 ) then x_str = '0x0'; return end if x_str = str( transfer(source=x, mold=1_int32), fmt='z' ); return end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'e' ) then if ( x == 0.0_real32 ) then x_str = '0.0e+00'; return end if if ( x < 0.0_real32 ) then allocate( character(len=15) :: x_str ) write(unit=x_str, fmt='(es15.8e2)', decimal=decimal) x do i = 15, 1, -1 if ( x_str(i:i) == 'E' ) then x_str(i:i) = 'e'; exit end if end do else allocate( character(len=14) :: x_str ) write(unit=x_str, fmt='(es14.8e2)', decimal=decimal) x do i = 14, 1, -1 if ( x_str(i:i) == 'E' ) then x_str(i:i) = 'e'; exit end if end do end if if ( .not. present(decimals) ) return if ( decimals >= 8 ) return if ( decimals < 0 ) then decimals_ = 0 else decimals_ = decimals end if do i = 1, 14 if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) then x_str = x_str(:i+decimals_)//x_str(i+9:); return end if end do else if ( fmt_ == 'f' ) then if ( abs(x) /= 0.0_real32 ) then e = int(log10(abs(x))) else x_str = '0.0'; return end if if ( e == 0 ) then if ( floor(x) > 0 ) e = 1 + e else if ( e > 0 ) then e = 1 + e end if allocate( character(len=75) :: x_str ) if ( e > 0 ) then write(unit=x_str, fmt='(f0.9)', decimal=decimal) x else write(unit=x_str, fmt='(f0.70)', decimal=decimal) x end if i = 1 do while ( i <= 75 ) if ( (x_str(i:i) == POINT) .or. (x_str(i:i) == COMMA) ) exit i = i + 1; cycle end do if ( (i == 1) .or. ( (i == 2) .and. (x_str(1:1) == '-') ) ) then x_str(i+1:75) = x_str(i:74); x_str(i:i) = '0'; i = i + 1 end if if ( i > 9 ) then x_str = x_str(:i)//'0'; return end if if ( .not. present(decimals) ) then x_str = x_str(:i+9-e); return end if if ( decimals <= 0 ) then x_str = x_str(:i)//'0'; return end if if ( decimals >= 9-e ) then x_str = x_str(:i+9-e); return end if x_str = x_str(:i+decimals); return end if end procedure str_r32 module procedure str_i64 character(len=1) :: fmt_ integer(int64) :: num logical :: negative integer :: num_len, i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == -huge(1_int64)-1_int64 ) then x_str = '-9223372036854775808'; return end if num_len = 2; num = abs(x); negative = .true. else num_len = 1; num = x; negative = .false. end if count_digits: do num = num/10 if ( num > 0 ) then num_len = num_len + 1; cycle count_digits else exit count_digits end if end do count_digits allocate( character(len=num_len) :: x_str ) if ( negative ) then num = abs(x) do i = num_len, 2, -1 x_str(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do x_str(1:1) = '-'; return else num = x do i = num_len, 1, -1 x_str(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do return end if else if ( fmt_ == 'z' ) then if ( x < 0 ) then num_len = 1; num = (x + 1_int64) + huge(1_int64); negative = .true. else num_len = 1; num = x; negative = .false. end if count_hex_digits: do num = num/16 if ( num > 0 ) then num_len = num_len + 1; cycle count_hex_digits else exit count_hex_digits end if end do count_hex_digits if ( negative ) then num = (x + 1_int64) + huge(1_int64) x_str = '0x0000000000000000' else num = x allocate( character(len=2+num_len) :: x_str ); x_str(1:2) = '0x' end if insert_hex_characters: do i = len(x_str), len(x_str)-num_len+1, -1 x_str(i:i) = DIGITS_A( mod(num,16) ); num = num/16 end do insert_hex_characters if ( negative ) then i = 0; do if ( DIGITS_A(i) == x_str(3:3) ) exit i = i + 1; cycle end do x_str(3:3) = DIGITS_A(i+8); return else return end if end if end procedure str_i64 module procedure str_i32 character(len=1) :: fmt_ integer(int32) :: num logical :: negative integer :: num_len, i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == -huge(1_int32)-1_int32 ) then x_str = '-2147483648'; return end if num_len = 2; num = abs(x); negative = .true. else num_len = 1; num = x; negative = .false. end if count_digits: do num = num/10 if ( num > 0 ) then num_len = num_len + 1; cycle count_digits else exit count_digits end if end do count_digits allocate( character(len=num_len) :: x_str ) if ( negative ) then num = abs(x) do i = num_len, 2, -1 x_str(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do x_str(1:1) = '-'; return else num = x do i = num_len, 1, -1 x_str(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do return end if else if ( fmt_ == 'z' ) then if ( x < 0 ) then num_len = 1; num = (x + 1_int32) + huge(1_int32); negative = .true. else num_len = 1; num = x; negative = .false. end if count_hex_digits: do num = num/16 if ( num > 0 ) then num_len = num_len + 1; cycle count_hex_digits else exit count_hex_digits end if end do count_hex_digits if ( negative ) then num = (x + 1_int32) + huge(1_int32) x_str = '0x00000000' else num = x allocate( character(len=2+num_len) :: x_str ); x_str(1:2) = '0x' end if insert_hex_characters: do i = len(x_str), len(x_str)-num_len+1, -1 x_str(i:i) = DIGITS_A( mod(num,16) ); num = num/16 end do insert_hex_characters if ( negative ) then i = 0; do if ( DIGITS_A(i) == x_str(3:3) ) exit i = i + 1; cycle end do x_str(3:3) = DIGITS_A(i+8); return else return end if end if end procedure str_i32 module procedure str_i16 character(len=1) :: fmt_ integer(int16) :: num logical :: negative integer :: num_len, i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == -huge(1_int16)-1_int16 ) then x_str = '-32768'; return end if num_len = 2; num = abs(x); negative = .true. else num_len = 1; num = x; negative = .false. end if count_digits: do num = num/10 if ( num > 0 ) then num_len = num_len + 1; cycle count_digits else exit count_digits end if end do count_digits allocate( character(len=num_len) :: x_str ) if ( negative ) then num = abs(x) do i = num_len, 2, -1 x_str(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do x_str(1:1) = '-'; return else num = x do i = num_len, 1, -1 x_str(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do return end if else if ( fmt_ == 'z' ) then if ( x < 0 ) then num_len = 1; num = (x + 1_int16) + huge(1_int16); negative = .true. else num_len = 1; num = x; negative = .false. end if count_hex_digits: do num = num/16 if ( num > 0 ) then num_len = num_len + 1; cycle count_hex_digits else exit count_hex_digits end if end do count_hex_digits if ( negative ) then num = (x + 1_int16) + huge(1_int16) x_str = '0x0000' else num = x allocate( character(len=2+num_len) :: x_str ); x_str(1:2) = '0x' end if insert_hex_characters: do i = len(x_str), len(x_str)-num_len+1, -1 x_str(i:i) = DIGITS_A( mod(num,16) ); num = num/16 end do insert_hex_characters if ( negative ) then i = 0; do if ( DIGITS_A(i) == x_str(3:3) ) exit i = i + 1; cycle end do x_str(3:3) = DIGITS_A(i+8); return else return end if end if end procedure str_i16 module procedure str_i8 character(len=1) :: fmt_ integer(int8) :: num logical :: negative integer :: num_len, i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else x_str = EMPTY_STR; return end if end if if ( fmt_ == 'i' ) then if ( x < 0 ) then if ( x == -huge(1_int8)-1_int8 ) then x_str = '-128'; return end if num_len = 2; num = abs(x); negative = .true. else num_len = 1; num = x; negative = .false. end if count_digits: do num = num/10 if ( num > 0 ) then num_len = num_len + 1; cycle count_digits else exit count_digits end if end do count_digits allocate( character(len=num_len) :: x_str ) if ( negative ) then num = abs(x) do i = num_len, 2, -1 x_str(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do x_str(1:1) = '-'; return else num = x do i = num_len, 1, -1 x_str(i:i) = DIGITS_A( mod(num,10) ); num = num/10 end do return end if else if ( fmt_ == 'z' ) then if ( x < 0 ) then num_len = 1; num = (x + 1_int8) + huge(1_int8); negative = .true. else num_len = 1; num = x; negative = .false. end if count_hex_digits: do num = num/16 if ( num > 0 ) then num_len = num_len + 1; cycle count_hex_digits else exit count_hex_digits end if end do count_hex_digits if ( negative ) then num = (x + 1_int8) + huge(1_int8) x_str = '0x00' else num = x allocate( character(len=2+num_len) :: x_str ); x_str(1:2) = '0x' end if insert_hex_characters: do i = len(x_str), len(x_str)-num_len+1, -1 x_str(i:i) = DIGITS_A( mod(num,16) ); num = num/16 end do insert_hex_characters if ( negative ) then i = 0; do if ( DIGITS_A(i) == x_str(3:3) ) exit i = i + 1; cycle end do x_str(3:3) = DIGITS_A(i+8); return end if else return end if end procedure str_i8 module procedure str_string if ( x%len() < 1 ) then x_str = EMPTY_STR else x_str = x%s end if end procedure str_string module procedure str_char x_str = x end procedure str_char module procedure str_empty x_str = EMPTY_STR end procedure str_empty module procedure cast_c128 character(len=1) :: fmt_ character(len=:), allocatable :: im_, decimal character(len=:), allocatable, dimension(:) :: seps, e_chars real(real128) :: z_re, z_im integer, allocatable :: substring_len, i, l, r, im_len substring_len = len(substring) if ( substring_len < 1 ) then into = (0.0_real128,0.0_real128); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real128,0.0_real128); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real128,0.0_real128); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then seps = [ COMMA ] else seps = [ SEMICOLON ] end if l = 1; do while ( l <= substring_len ) if ( substring(l:l) == '(' ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= 1 ) if ( substring(r:r) == ')' ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( substring(i:i) == seps(1) ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then if ( i-l-1 > 2 ) then if ( substring(l+1:l+2) == '0x' ) then read(unit=substring(l+3:i-1), fmt='(z100)') z_re else read(unit=substring(l+1:i-1), fmt='(z100)') z_re end if else read(unit=substring(l+1:i-1), fmt='(z100)') z_re end if if ( r-i-1 > 2 ) then if ( substring(i+1:i+2) == '0x' ) then read(unit=substring(i+3:r-1), fmt='(z100)') z_im else read(unit=substring(i+1:r-1), fmt='(z100)') z_im end if else read(unit=substring(i+1:r-1), fmt='(z100)') z_im end if into = cmplx(z_re, z_im, kind=real128); return else read(unit=substring(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real128); return end if end if im_len = len(im_); seps = [ '+', '-' ]; e_chars = [ 'e', 'E' ] l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do while ( r >= 1 ) if ( substring(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( any(seps == substring(i:i)) ) then if ( any(e_chars == substring(i-1:i-1)) .and. (fmt_ /= 'z') ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do if ( fmt_ == 'z' ) then if ( i-l > 2 ) then if ( substring(l:l+1) == '0x' ) then read(unit=substring(l+2:i-1), fmt='(z100)') z_re else read(unit=substring(l:i-1), fmt='(z100)') z_re end if else read(unit=substring(l:i-1), fmt='(z100)') z_re end if if ( r-i-1 > 2 ) then if ( substring(i+1:i+2) == '0x' ) then read(unit=substring(i+3:r-1), fmt='(z100)') z_im else read(unit=substring(i+1:r-1), fmt='(z100)') z_im end if else read(unit=substring(i+1:r-1), fmt='(z100)') z_im end if into = cmplx(z_re, z_im, kind=real128); return else read(unit=substring(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real128); return end if end procedure cast_c128 module procedure cast_c64 character(len=1) :: fmt_ character(len=:), allocatable :: im_, decimal character(len=:), allocatable, dimension(:) :: seps, e_chars real(real64) :: z_re, z_im integer, allocatable :: substring_len, i, l, r, im_len substring_len = len(substring) if ( substring_len < 1 ) then into = (0.0_real64,0.0_real64); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real64,0.0_real64); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real64,0.0_real64); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then seps = [ COMMA ] else seps = [ SEMICOLON ] end if l = 1; do while ( l <= substring_len ) if ( substring(l:l) == '(' ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= 1 ) if ( substring(r:r) == ')' ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( substring(i:i) == seps(1) ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer(int64) :: num call cast(substring(l+1:i-1), into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(substring(i+1:r-1), into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real64); return end block else read(unit=substring(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real64); return end if end if im_len = len(im_); seps = [ '+', '-' ]; e_chars = [ 'e', 'E' ] l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do while ( r >= 1 ) if ( substring(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( any(seps == substring(i:i)) ) then if ( any(e_chars == substring(i-1:i-1)) .and. (fmt_ /= 'z') ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer(int64) :: num call cast(substring(l:i-1), into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(substring(i+1:r-1), into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real64); return end block else read(unit=substring(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real64); return end if end procedure cast_c64 module procedure cast_c32 character(len=1) :: fmt_ character(len=:), allocatable :: im_, decimal character(len=:), allocatable, dimension(:) :: seps, e_chars real(real32) :: z_re, z_im integer, allocatable :: substring_len, i, l, r, im_len substring_len = len(substring) if ( substring_len < 1 ) then into = (0.0_real32,0.0_real32); return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = (0.0_real32,0.0_real32); return end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = (0.0_real32,0.0_real32); return end if end if if ( len(im_) == 0 ) then if ( decimal == 'POINT' ) then seps = [ COMMA ] else seps = [ SEMICOLON ] end if l = 1; do while ( l <= substring_len ) if ( substring(l:l) == '(' ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= 1 ) if ( substring(r:r) == ')' ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( substring(i:i) == seps(1) ) exit i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer(int32) :: num call cast(substring(l+1:i-1), into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(substring(i+1:r-1), into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real32); return end block else read(unit=substring(l+1:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i+1:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real32); return end if end if im_len = len(im_); seps = [ '+', '-' ]; e_chars = [ 'e', 'E' ] l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len-im_len+1; do while ( r >= 1 ) if ( substring(r:r+im_len-1) == im_ ) exit r = r - 1; cycle end do i = l+1; do while ( i <= r ) if ( any(seps == substring(i:i)) ) then if ( any(e_chars == substring(i-1:i-1)) .and. (fmt_ /= 'z') ) then i = i + 1; cycle else exit end if end if i = i + 1; cycle end do if ( fmt_ == 'z' ) then block; integer(int32) :: num call cast(substring(l:i-1), into=num, fmt='z'); z_re = transfer(source=num, mold=z_re) call cast(substring(i+1:r-1), into=num, fmt='z'); z_im = transfer(source=num, mold=z_im) into = cmplx(z_re, z_im, kind=real32); return end block else read(unit=substring(l:i-1), fmt=*, decimal=decimal) z_re read(unit=substring(i:r-1), fmt=*, decimal=decimal) z_im into = cmplx(z_re, z_im, kind=real32); return end if end procedure cast_c32 module procedure cast_r128 character(len=1) :: fmt_ character(len=:), allocatable :: decimal if ( len(substring) < 1 ) then into = 0.0_real128; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real128; return end if end if if ( fmt_ == 'z' ) then if ( len(substring) > 2 ) then if ( substring(1:2) == '0x' ) then read(unit=substring(3:), fmt='(z100)') into; return else read(unit=substring, fmt='(z100)') into; return end if else read(unit=substring, fmt='(z100)') into; return end if end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real128; return end if end if read(unit=substring, fmt=*, decimal=decimal) into end procedure cast_r128 module procedure cast_r64 character(len=1) :: fmt_ character(len=:), allocatable :: decimal if ( len(substring) < 1 ) then into = 0.0_real64; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real64; return end if end if if ( fmt_ == 'z' ) then block; integer(int64) :: num call cast(substring, into=num, fmt='z'); into = transfer(source=num, mold=into); return end block end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real64; return end if end if read(unit=substring, fmt=*, decimal=decimal) into end procedure cast_r64 module procedure cast_r32 character(len=1) :: fmt_ character(len=:), allocatable :: decimal if ( len(substring) < 1 ) then into = 0.0_real32; return end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else into = 0.0_real32; return end if end if if ( fmt_ == 'z' ) then block; integer(int32) :: num call cast(substring, into=num, fmt='z'); into = transfer(source=num, mold=into); return end block end if if ( .not. present(locale) ) then decimal = 'POINT' else if ( locale == 'US' ) then decimal = 'POINT' else if ( locale == 'EU' ) then decimal = 'COMMA' else into = 0.0_real32; return end if end if read(unit=substring, fmt=*, decimal=decimal) into end procedure cast_r32 module procedure cast_i64 character(len=1) :: fmt_ logical :: negative integer :: substring_len, l, r, j integer(int64) :: i substring_len = len(substring) if ( substring_len < 1 ) then into = 0_int64; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int64; return end if end if if ( fmt_ == 'i' ) then l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= l ) if ( substring(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( substring(l:l) == '-' ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int64 i = 1_int64; do j = 0; do while ( j <= 9 ) if ( DIGITS_A(j) == substring(r:r) ) exit j = j + 1; cycle end do into = into + i*int(DIGITS_I(j), kind=int64) if ( r == l ) exit i = 10_int64*i; r = r - 1; cycle end do if ( negative ) then into = -into; return else return end if else if ( fmt_ == 'z' ) then l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do if ( substring_len > 2 ) then if ( substring(l:l+1) == '0x' ) l = l + 2 end if r = substring_len; do while ( r >= l ) if ( substring(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( r-l+1 == 16 ) then j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring(l:l) ) exit j = j + 1; cycle end do if ( j >= 8 ) then negative = .true. else negative = .false. end if else negative = .false. end if into = 0_int64 i = 1_int64; do j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring(r:r) ) exit j = j + 1; cycle end do if ( r > l ) then into = into + i*int(DIGITS_I(j), kind=int64) else if ( r == l ) then if ( negative ) then into = into + i*int(DIGITS_I(j-8), kind=int64); into = (into - 1_int64) - huge(1_int64); return else into = into + i*int(DIGITS_I(j), kind=int64); return end if end if i = 16_int64*i; r = r - 1; cycle end do end if end procedure cast_i64 module procedure cast_i32 character(len=1) :: fmt_ logical :: negative integer :: substring_len, l, r, j integer(int32) :: i substring_len = len(substring) if ( substring_len < 1 ) then into = 0_int32; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int32; return end if end if if ( fmt_ == 'i' ) then l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= l ) if ( substring(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( substring(l:l) == '-' ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int32 i = 1_int32; do j = 0; do while ( j <= 9 ) if ( DIGITS_A(j) == substring(r:r) ) exit j = j + 1; cycle end do into = into + i*DIGITS_I(j) if ( r == l ) exit i = 10_int32*i; r = r - 1; cycle end do if ( negative ) then into = -into; return else return end if else if ( fmt_ == 'z' ) then l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do if ( substring_len > 2 ) then if ( substring(l:l+1) == '0x' ) l = l + 2 end if r = substring_len; do while ( r >= l ) if ( substring(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( r-l+1 == 8 ) then j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring(l:l) ) exit j = j + 1; cycle end do if ( j >= 8 ) then negative = .true. else negative = .false. end if else negative = .false. end if into = 0_int32 i = 1_int32; do j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring(r:r) ) exit j = j + 1; cycle end do if ( r > l ) then into = into + i*DIGITS_I(j) else if ( r == l ) then if ( negative ) then into = into + i*DIGITS_I(j-8); into = (into - 1_int32) - huge(1_int32); return else into = into + i*DIGITS_I(j); return end if end if i = 16_int32*i; r = r - 1; cycle end do end if end procedure cast_i32 module procedure cast_i16 character(len=1) :: fmt_ logical :: negative integer :: substring_len, l, r, j integer(int16) :: i substring_len = len(substring) if ( substring_len < 1 ) then into = 0_int16; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int16; return end if end if if ( fmt_ == 'i' ) then l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= l ) if ( substring(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( substring(l:l) == '-' ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int16 i = 1_int16; do j = 0; do while ( j <= 9 ) if ( DIGITS_A(j) == substring(r:r) ) exit j = j + 1; cycle end do into = into + i*int(DIGITS_I(j), kind=int16) if ( r == l ) exit i = 10_int16*i; r = r - 1; cycle end do if ( negative ) then into = -into; return else return end if else if ( fmt_ == 'z' ) then l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do if ( substring_len > 2 ) then if ( substring(l:l+1) == '0x' ) l = l + 2 end if r = substring_len; do while ( r >= l ) if ( substring(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( r-l+1 == 4 ) then j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring(l:l) ) exit j = j + 1; cycle end do if ( j >= 8 ) then negative = .true. else negative = .false. end if else negative = .false. end if into = 0_int16 i = 1_int16; do j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring(r:r) ) exit j = j + 1; cycle end do if ( r > l ) then into = into + i*int(DIGITS_I(j), kind=int16) else if ( r == l ) then if ( negative ) then into = into + i*int(DIGITS_I(j-8), kind=int16); into = (into - 1_int16) - huge(1_int16); return else into = into + i*int(DIGITS_I(j), kind=int16); return end if end if i = 16_int16*i; r = r - 1; cycle end do end if end procedure cast_i16 module procedure cast_i8 character(len=1) :: fmt_ logical :: negative integer :: substring_len, l, r, j integer(int8) :: i substring_len = len(substring) if ( substring_len < 1 ) then into = 0_int8; return end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else into = 0_int8; return end if end if if ( fmt_ == 'i' ) then l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do r = substring_len; do while ( r >= l ) if ( substring(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( substring(l:l) == '-' ) then negative = .true.; l = l + 1 else negative = .false. end if into = 0_int8 i = 1_int8; do j = 0; do while ( j <= 9 ) if ( DIGITS_A(j) == substring(r:r) ) exit j = j + 1; cycle end do into = into + i*int(DIGITS_I(j), kind=int8) if ( r == l ) exit i = 10_int8*i; r = r - 1; cycle end do if ( negative ) then into = -into; return else return end if else if ( fmt_ == 'z' ) then l = 1; do while ( l <= substring_len ) if ( substring(l:l) /= SPACE ) exit l = l + 1; cycle end do if ( substring_len > 2 ) then if ( substring(l:l+1) == '0x' ) l = l + 2 end if r = substring_len; do while ( r >= l ) if ( substring(r:r) /= SPACE ) exit r = r - 1; cycle end do if ( r-l+1 == 2 ) then j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring(l:l) ) exit j = j + 1; cycle end do if ( j >= 8 ) then negative = .true. else negative = .false. end if else negative = .false. end if into = 0_int8 i = 1_int8; do j = 0; do while ( j <= 15 ) if ( DIGITS_A(j) == substring(r:r) ) exit j = j + 1; cycle end do if ( r > l ) then into = into + i*int(DIGITS_I(j), kind=int8) else if ( r == l ) then if ( negative ) then into = into + i*int(DIGITS_I(j-8), kind=int8); into = (into - 1_int8) - huge(1_int8); return else into = into + i*int(DIGITS_I(j), kind=int8); return end if end if i = 16_int8*i; r = r - 1; cycle end do end if end procedure cast_i8 end submodule internal_io submodule (io_fortran_lib) join_split !! This submodule provides module procedure implementations for the **public interfaces** `join` and `split`. contains module procedure join_char type(String) :: temp_String character(len=:), allocatable :: separator_ if ( .not. present(separator) ) then separator_ = SPACE else separator_ = separator end if temp_String = join(String(tokens), separator=separator_) if ( temp_String%len() < 1 ) then new = EMPTY_STR else new = temp_String%s end if end procedure join_char module procedure join_string type(String), dimension(2) :: token_pair character(len=:), allocatable :: separator_ integer(int64) :: num_tokens num_tokens = size(tokens, kind=int64) if ( num_tokens == 1_int64 ) then if ( tokens(1_int64)%len64() < 1_int64 ) then new%s = EMPTY_STR; return else new%s = tokens(1_int64)%s; return end if end if if ( .not. present(separator) ) then separator_ = SPACE else separator_ = separator end if if ( num_tokens > 500_int64 ) then new = join(tokens=[ join(tokens(:num_tokens/2_int64), separator_), & join(tokens(1_int64+num_tokens/2_int64:), separator_) ], separator=separator_) else call new%join_base(tokens=tokens, separator=separator_) end if end procedure join_string module procedure split_char character(len=:), allocatable :: separator_ if ( .not. present(separator) ) then separator_ = SPACE else separator_ = separator end if tokens = split(String(substring), separator=separator_) end procedure split_char module procedure split_string character(len=:), allocatable :: separator_ integer(int64) :: substring_len, sep_len, num_seps, i integer(int64), allocatable, dimension(:) :: sep_positions substring_len = substring%len64() if ( substring_len < 1_int64 ) then allocate( tokens(1) ); tokens(1)%s = EMPTY_STR; return end if if ( .not. present(separator) ) then separator_ = SPACE else separator_ = separator end if sep_len = len(separator_, kind=int64) if ( sep_len == 0_int64 ) then allocate( tokens(substring_len) ) do concurrent (i = 1_int64:substring_len) tokens(i)%s = substring%s(i:i) end do return end if num_seps = 0_int64 i = 1_int64 allocate( sep_positions(substring_len) ) count_seps: do while ( i <= substring_len-sep_len+1_int64 ) if ( substring%s(i:i+sep_len-1_int64) == separator_ ) then num_seps = num_seps + 1_int64; sep_positions(num_seps) = i i = i + sep_len; cycle count_seps else i = i + 1_int64; cycle count_seps end if end do count_seps if ( num_seps == 0_int64 ) then allocate( tokens(1) ); tokens(1)%s = substring%s; return end if allocate( tokens(num_seps + 1_int64) ) positional_transfers: do concurrent (i = 1:num_seps) if ( i == 1_int64 ) then if ( sep_positions(i) == 1_int64 ) then tokens(i)%s = EMPTY_STR else tokens(i)%s = substring%s(1_int64:sep_positions(i)-1_int64) end if else if ( sep_positions(i) == sep_positions(i-1_int64)+sep_len ) then tokens(i)%s = EMPTY_STR else tokens(i)%s = substring%s(sep_positions(i-1_int64)+sep_len:sep_positions(i)-1_int64) end if end if if ( i == num_seps ) then if ( sep_positions(i)+sep_len > substring_len ) then tokens(i+1_int64)%s = EMPTY_STR else tokens(i+1_int64)%s = substring%s(sep_positions(i)+sep_len:) end if end if end do positional_transfers end procedure split_string end submodule join_split submodule (io_fortran_lib) file_io !! This submodule provides module procedure implementations for the **public interfaces** `to_file` and !! `from_file`. contains ! Writing Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure to_file_1dc128 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dc128 module procedure to_file_1dc64 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dc64 module procedure to_file_1dc32 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dc32 module procedure to_file_2dc128 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dc128 module procedure to_file_2dc64 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dc64 module procedure to_file_2dc32 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = trim(adjustl(im)) end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' if ( present(im) ) write(*,'(a)') LF//'WARNING: im not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dc32 module procedure to_file_3dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dc128 module procedure to_file_3dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dc64 module procedure to_file_3dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dc32 module procedure to_file_4dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dc128 module procedure to_file_4dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dc64 module procedure to_file_4dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dc32 module procedure to_file_5dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dc128 module procedure to_file_5dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dc64 module procedure to_file_5dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dc32 module procedure to_file_6dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dc128 module procedure to_file_6dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dc64 module procedure to_file_6dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dc32 module procedure to_file_7dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dc128 module procedure to_file_7dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dc64 module procedure to_file_7dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dc32 module procedure to_file_8dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dc128 module procedure to_file_8dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dc64 module procedure to_file_8dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dc32 module procedure to_file_9dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dc128 module procedure to_file_9dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dc64 module procedure to_file_9dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dc32 module procedure to_file_10dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dc128 module procedure to_file_10dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dc64 module procedure to_file_10dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dc32 module procedure to_file_11dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dc128 module procedure to_file_11dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dc64 module procedure to_file_11dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dc32 module procedure to_file_12dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dc128 module procedure to_file_12dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dc64 module procedure to_file_12dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dc32 module procedure to_file_13dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dc128 module procedure to_file_13dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dc64 module procedure to_file_13dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dc32 module procedure to_file_14dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dc128 module procedure to_file_14dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dc64 module procedure to_file_14dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dc32 module procedure to_file_15dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dc128 module procedure to_file_15dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dc64 module procedure to_file_15dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dc32 module procedure to_file_1dr128 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dr128 module procedure to_file_1dr64 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dr64 module procedure to_file_1dr32 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_, hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, dim=dim_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1dr32 module procedure to_file_2dr128 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dr128 module procedure to_file_2dr64 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dr64 module procedure to_file_2dr32 character(len=:), allocatable, dimension(:) :: header_ character(len=:), allocatable :: ext, locale_, delim_, fmt_ integer :: decimals_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else locale_ = 'US' write(*,'(a)') LF//'WARNING: Invalid locale "'//locale//'" for file "'//file_name//'". '// & 'Defaulting to US format.'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'e' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to exponential format.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(decimals) ) then decimals_ = 150 else decimals_ = decimals end if call to_text( x=x, file_name=file_name, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, decimals=decimals_ ) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(locale) ) write(*,'(a)') LF//'WARNING: locale not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' if ( present(decimals) ) write(*,'(a)') LF//'WARNING: decimals not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2dr32 module procedure to_file_3dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dr128 module procedure to_file_3dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dr64 module procedure to_file_3dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3dr32 module procedure to_file_4dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dr128 module procedure to_file_4dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dr64 module procedure to_file_4dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4dr32 module procedure to_file_5dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dr128 module procedure to_file_5dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dr64 module procedure to_file_5dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5dr32 module procedure to_file_6dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dr128 module procedure to_file_6dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dr64 module procedure to_file_6dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6dr32 module procedure to_file_7dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dr128 module procedure to_file_7dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dr64 module procedure to_file_7dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7dr32 module procedure to_file_8dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dr128 module procedure to_file_8dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dr64 module procedure to_file_8dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8dr32 module procedure to_file_9dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dr128 module procedure to_file_9dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dr64 module procedure to_file_9dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9dr32 module procedure to_file_10dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dr128 module procedure to_file_10dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dr64 module procedure to_file_10dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10dr32 module procedure to_file_11dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dr128 module procedure to_file_11dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dr64 module procedure to_file_11dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11dr32 module procedure to_file_12dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dr128 module procedure to_file_12dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dr64 module procedure to_file_12dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12dr32 module procedure to_file_13dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dr128 module procedure to_file_13dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dr64 module procedure to_file_13dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13dr32 module procedure to_file_14dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dr128 module procedure to_file_14dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dr64 module procedure to_file_14dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14dr32 module procedure to_file_15dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dr128 module procedure to_file_15dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dr64 module procedure to_file_15dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15dr32 module procedure to_file_1di64 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ integer :: hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = COMMA end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, dim=dim_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1di64 module procedure to_file_1di32 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ integer :: hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = COMMA end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, dim=dim_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1di32 module procedure to_file_1di16 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ integer :: hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = COMMA end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, dim=dim_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1di16 module procedure to_file_1di8 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ integer :: hstat, dim_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] hstat = 0 else if ( (size(header,kind=int64) /= 1_int64) .and. (size(header,kind=int64) /= size(x,kind=int64)) ) then header_ = [ EMPTY_STR ] hstat = -1 write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, kind=int64))//').' else header_ = header if ( size(header, kind=int64) == 1_int64 ) then hstat = 1 else hstat = 2 end if end if end if if ( .not. present(dim) ) then if ( hstat == 2 ) then dim_ = 2 else dim_ = 1 end if else if ( hstat == 2 ) then dim_ = 2 if ( dim /= 2 ) then write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (2).' end if else if ( dim == 1 ) then dim_ = 1 else if ( dim == 2 ) then dim_ = 2 else dim_ = 1 write(*,'(a)') LF//'WARNING: Invalid dim ('//str(dim)//') in write to file "'// & file_name//'" for given header... defaulting to (1).' end if end if end if if ( .not. present(delim) ) then if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = COMMA end if else if ( dim_ == 1 ) then delim_ = EMPTY_STR else delim_ = delim end if end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, dim=dim_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(dim) ) write(*,'(a)') LF//'WARNING: dim not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_1di8 module procedure to_file_2di64 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2di64 module procedure to_file_2di32 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2di32 module procedure to_file_2di16 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2di16 module procedure to_file_2di8 character(len=:), allocatable :: ext, delim_, fmt_ character(len=:), allocatable, dimension(:) :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = [ EMPTY_STR ] else if ( (size(header,kind=int64)/=1_int64).and.(size(header,kind=int64)/=size(x,dim=2,kind=int64)) ) then header_ = [ EMPTY_STR ] write(*,'(a)') LF//'WARNING: Invalid header for file "'//file_name//'".'// & LF//'Header for this data must have size (1) or '// & '('//str(size(x, dim=2, kind=int64))//').' else header_ = header end if end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' write(*,'(a)') LF//'WARNING: Invalid format "'//fmt//'" for file "'//file_name//'". '// & 'Defaulting to integer format.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call to_text(x=x, file_name=file_name, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then if ( present(header) ) write(*,'(a)') LF//'WARNING: header not supported for file type "'//ext//'".' if ( present(delim) ) write(*,'(a)') LF//'WARNING: delim not supported for file type "'//ext//'".' if ( present(fmt) ) write(*,'(a)') LF//'WARNING: fmt not supported for file type "'//ext//'".' call to_binary(x=x, file_name=file_name) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end procedure to_file_2di8 module procedure to_file_3di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3di64 module procedure to_file_3di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3di32 module procedure to_file_3di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3di16 module procedure to_file_3di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_3di8 module procedure to_file_4di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4di64 module procedure to_file_4di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4di32 module procedure to_file_4di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4di16 module procedure to_file_4di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_4di8 module procedure to_file_5di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5di64 module procedure to_file_5di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5di32 module procedure to_file_5di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5di16 module procedure to_file_5di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_5di8 module procedure to_file_6di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6di64 module procedure to_file_6di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6di32 module procedure to_file_6di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6di16 module procedure to_file_6di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_6di8 module procedure to_file_7di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7di64 module procedure to_file_7di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7di32 module procedure to_file_7di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7di16 module procedure to_file_7di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_7di8 module procedure to_file_8di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8di64 module procedure to_file_8di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8di32 module procedure to_file_8di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8di16 module procedure to_file_8di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_8di8 module procedure to_file_9di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9di64 module procedure to_file_9di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9di32 module procedure to_file_9di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9di16 module procedure to_file_9di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_9di8 module procedure to_file_10di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10di64 module procedure to_file_10di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10di32 module procedure to_file_10di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10di16 module procedure to_file_10di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_10di8 module procedure to_file_11di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11di64 module procedure to_file_11di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11di32 module procedure to_file_11di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11di16 module procedure to_file_11di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_11di8 module procedure to_file_12di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12di64 module procedure to_file_12di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12di32 module procedure to_file_12di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12di16 module procedure to_file_12di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_12di8 module procedure to_file_13di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13di64 module procedure to_file_13di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13di32 module procedure to_file_13di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13di16 module procedure to_file_13di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_13di8 module procedure to_file_14di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14di64 module procedure to_file_14di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14di32 module procedure to_file_14di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14di16 module procedure to_file_14di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_14di8 module procedure to_file_15di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15di64 module procedure to_file_15di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15di32 module procedure to_file_15di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15di16 module procedure to_file_15di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then call to_binary(x=x, file_name=file_name) else if ( any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". Cannot write array of '// & 'dimension ('//str(rank(x))//') to text.'// & LF//'Supported file extensions: '//join(BINARY_EXT) else write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure to_file_15di8 ! Reading Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure from_textfile_1dc128 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dc128 module procedure from_binaryfile_1dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dc128 module procedure from_textfile_1dc64 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dc64 module procedure from_binaryfile_1dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dc64 module procedure from_textfile_1dc32 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dc32 module procedure from_binaryfile_1dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dc32 module procedure from_textfile_2dc128 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dc128 module procedure from_binaryfile_2dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dc128 module procedure from_textfile_2dc64 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dc64 module procedure from_binaryfile_2dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dc64 module procedure from_textfile_2dc32 character(len=:), allocatable :: ext, locale_, delim_, fmt_, im_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into complex array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if if ( .not. present(im) ) then im_ = EMPTY_STR else im_ = im end if call from_text( file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, & fmt=fmt_, im=im_ ) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dc32 module procedure from_binaryfile_2dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dc32 module procedure from_file_3dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dc128 module procedure from_file_3dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dc64 module procedure from_file_3dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dc32 module procedure from_file_4dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dc128 module procedure from_file_4dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dc64 module procedure from_file_4dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dc32 module procedure from_file_5dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dc128 module procedure from_file_5dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dc64 module procedure from_file_5dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dc32 module procedure from_file_6dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dc128 module procedure from_file_6dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dc64 module procedure from_file_6dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dc32 module procedure from_file_7dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dc128 module procedure from_file_7dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dc64 module procedure from_file_7dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dc32 module procedure from_file_8dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dc128 module procedure from_file_8dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dc64 module procedure from_file_8dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dc32 module procedure from_file_9dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dc128 module procedure from_file_9dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dc64 module procedure from_file_9dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dc32 module procedure from_file_10dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dc128 module procedure from_file_10dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dc64 module procedure from_file_10dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dc32 module procedure from_file_11dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dc128 module procedure from_file_11dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dc64 module procedure from_file_11dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dc32 module procedure from_file_12dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dc128 module procedure from_file_12dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dc64 module procedure from_file_12dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dc32 module procedure from_file_13dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dc128 module procedure from_file_13dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dc64 module procedure from_file_13dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dc32 module procedure from_file_14dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dc128 module procedure from_file_14dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dc64 module procedure from_file_14dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dc32 module procedure from_file_15dc128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dc128 module procedure from_file_15dc64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dc64 module procedure from_file_15dc32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dc32 module procedure from_textfile_1dr128 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dr128 module procedure from_binaryfile_1dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dr128 module procedure from_textfile_1dr64 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dr64 module procedure from_binaryfile_1dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dr64 module procedure from_textfile_1dr32 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1dr32 module procedure from_binaryfile_1dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1dr32 module procedure from_textfile_2dr128 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dr128 module procedure from_binaryfile_2dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dr128 module procedure from_textfile_2dr64 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dr64 module procedure from_binaryfile_2dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dr64 module procedure from_textfile_2dr32 character(len=:), allocatable :: ext, locale_, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(locale) ) then locale_ = 'US' else if ( any(LOCALES == locale) ) then locale_ = locale else error stop LF//'FATAL: Invalid locale "'//locale//'" for read of file "'//file_name//'".'// & LF//'Locale must be one of: '//join(LOCALES) end if end if if ( .not. present(delim) ) then if ( locale_ == 'US' ) then delim_ = COMMA else delim_ = SEMICOLON end if else delim_ = delim if ( locale_ == 'US' ) then if ( delim_ == POINT ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with US decimal.' end if else if ( delim_ == COMMA ) then error stop LF//'FATAL: Invalid delimiter for read of file "'//file_name//'" with EU decimal.' end if end if end if if ( .not. present(fmt) ) then fmt_ = 'e' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into real array.'// & LF//'Format must be one of: '//join(REAL_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, locale=locale_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2dr32 module procedure from_binaryfile_2dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2dr32 module procedure from_file_3dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dr128 module procedure from_file_3dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dr64 module procedure from_file_3dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3dr32 module procedure from_file_4dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dr128 module procedure from_file_4dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dr64 module procedure from_file_4dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4dr32 module procedure from_file_5dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dr128 module procedure from_file_5dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dr64 module procedure from_file_5dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5dr32 module procedure from_file_6dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dr128 module procedure from_file_6dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dr64 module procedure from_file_6dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6dr32 module procedure from_file_7dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dr128 module procedure from_file_7dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dr64 module procedure from_file_7dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7dr32 module procedure from_file_8dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dr128 module procedure from_file_8dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dr64 module procedure from_file_8dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8dr32 module procedure from_file_9dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dr128 module procedure from_file_9dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dr64 module procedure from_file_9dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9dr32 module procedure from_file_10dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dr128 module procedure from_file_10dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dr64 module procedure from_file_10dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10dr32 module procedure from_file_11dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dr128 module procedure from_file_11dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dr64 module procedure from_file_11dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11dr32 module procedure from_file_12dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dr128 module procedure from_file_12dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dr64 module procedure from_file_12dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12dr32 module procedure from_file_13dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dr128 module procedure from_file_13dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dr64 module procedure from_file_13dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13dr32 module procedure from_file_14dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dr128 module procedure from_file_14dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dr64 module procedure from_file_14dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14dr32 module procedure from_file_15dr128 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dr128 module procedure from_file_15dr64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dr64 module procedure from_file_15dr32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15dr32 module procedure from_textfile_1di64 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1di64 module procedure from_binaryfile_1di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1di64 module procedure from_textfile_1di32 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1di32 module procedure from_binaryfile_1di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1di32 module procedure from_textfile_1di16 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1di16 module procedure from_binaryfile_1di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1di16 module procedure from_textfile_1di8 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_1di8 module procedure from_binaryfile_1di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_1di8 module procedure from_textfile_2di64 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2di64 module procedure from_binaryfile_2di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2di64 module procedure from_textfile_2di32 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2di32 module procedure from_binaryfile_2di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2di32 module procedure from_textfile_2di16 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2di16 module procedure from_binaryfile_2di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2di16 module procedure from_textfile_2di8 character(len=:), allocatable :: ext, delim_, fmt_ logical :: header_ ext = ext_of(file_name) if ( any(TEXT_EXT == ext) ) then if ( .not. present(header) ) then header_ = .false. else header_ = header end if if ( .not. present(delim) ) then delim_ = COMMA else delim_ = delim end if if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else error stop LF//'FATAL: Invalid format "'//fmt//'" for read of file "'//file_name//'" '// & 'into integer array.'// & LF//'Format must be one of: '//join(INT_FMTS) end if end if call from_text(file_name=file_name, into=into, header=header_, delim=delim_, fmt=fmt_) else if ( any(BINARY_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must be specified '// & 'for binary data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_textfile_2di8 module procedure from_binaryfile_2di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'", data_shape must not be specified '// & 'for textual data.' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT)//SPACE// & join(BINARY_EXT) end if end if end procedure from_binaryfile_2di8 module procedure from_file_3di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3di64 module procedure from_file_3di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3di32 module procedure from_file_3di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3di16 module procedure from_file_3di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_3di8 module procedure from_file_4di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4di64 module procedure from_file_4di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4di32 module procedure from_file_4di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4di16 module procedure from_file_4di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_4di8 module procedure from_file_5di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5di64 module procedure from_file_5di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5di32 module procedure from_file_5di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5di16 module procedure from_file_5di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_5di8 module procedure from_file_6di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6di64 module procedure from_file_6di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6di32 module procedure from_file_6di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6di16 module procedure from_file_6di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_6di8 module procedure from_file_7di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7di64 module procedure from_file_7di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7di32 module procedure from_file_7di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7di16 module procedure from_file_7di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_7di8 module procedure from_file_8di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8di64 module procedure from_file_8di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8di32 module procedure from_file_8di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8di16 module procedure from_file_8di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_8di8 module procedure from_file_9di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9di64 module procedure from_file_9di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9di32 module procedure from_file_9di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9di16 module procedure from_file_9di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_9di8 module procedure from_file_10di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10di64 module procedure from_file_10di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10di32 module procedure from_file_10di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10di16 module procedure from_file_10di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_10di8 module procedure from_file_11di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11di64 module procedure from_file_11di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11di32 module procedure from_file_11di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11di16 module procedure from_file_11di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_11di8 module procedure from_file_12di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12di64 module procedure from_file_12di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12di32 module procedure from_file_12di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12di16 module procedure from_file_12di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_12di8 module procedure from_file_13di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13di64 module procedure from_file_13di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13di32 module procedure from_file_13di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13di16 module procedure from_file_13di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_13di8 module procedure from_file_14di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14di64 module procedure from_file_14di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14di32 module procedure from_file_14di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14di16 module procedure from_file_14di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_14di8 module procedure from_file_15di64 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15di64 module procedure from_file_15di32 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15di32 module procedure from_file_15di16 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15di16 module procedure from_file_15di8 character(len=:), allocatable :: ext ext = ext_of(file_name) if ( any(BINARY_EXT == ext) ) then if ( size(data_shape) /= rank(into) ) then error stop LF//'FATAL: Shape mismatch in read of file "'//file_name//'".'// & LF//'Output array has dimension ('//str(rank(into))//') while data_shape has size (' & //str(size(data_shape))//'). These must match.' end if call from_binary(file_name=file_name, into=into, data_shape=data_shape) else if ( any(TEXT_EXT == ext) ) then error stop LF//'FATAL: Error reading file "'//file_name//'". Textual data cannot be read into '// & 'arrays of dimension greater than (2).' else error stop LF//'FATAL: Unsupported file extension "'//ext//'" for file "'//file_name//'".'// & LF//'Supported file extensions: '//join(BINARY_EXT) end if end if end procedure from_file_15di8 end submodule file_io submodule (io_fortran_lib) text_io !! This submodule provides module procedure implementations for the **public interface** `echo` and the **private !! interfaces** `to_text` and `from_text`. contains ! Writing Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure echo_chars character(len=:), allocatable :: ext, terminator_ logical :: exists, append_ integer :: file_unit ext = ext_of(file_name) if ( .not. any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT) return end if if ( len(substring, kind=int64) == 0_int64 ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". '// & 'String to write is empty.' return end if if ( .not. present(append) ) then append_ = .true. else append_ = append end if if ( .not. present(terminator) ) then terminator_ = LF else terminator_ = terminator end if inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else if ( .not. append_ ) then open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='write', access='stream', position='append' ) end if end if write( unit=file_unit ) substring//terminator_ close(file_unit) end procedure echo_chars module procedure echo_string character(len=:), allocatable :: ext, terminator_ logical :: exists, append_ integer :: file_unit ext = ext_of(file_name) if ( .not. any(TEXT_EXT == ext) ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'" '// & 'due to unsupported file extension "'//ext//'".'// & LF//'Supported file extensions: '//join(TEXT_EXT) return end if if ( substring%len64() < 1_int64 ) then write(*,'(a)') LF//'WARNING: Skipping write to "'//file_name//'". '// & 'String to write is empty.' return end if if ( .not. present(append) ) then append_ = .true. else append_ = append end if if ( .not. present(terminator) ) then terminator_ = LF else terminator_ = terminator end if inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else if ( .not. append_ ) then open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='write', access='stream', position='append' ) end if end if write( unit=file_unit ) substring%s//terminator_ close(file_unit) end procedure echo_string module procedure to_text_1dc128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then cells(2_int64:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) else cells(2_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) end if else if ( dim == 1 ) then cells(:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) else cells(1_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dc128 module procedure to_text_1dc64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then cells(2_int64:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) else cells(2_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) end if else if ( dim == 1 ) then cells(:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) else cells(1_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dc64 module procedure to_text_1dc32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then cells(2_int64:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) else cells(2_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) end if else if ( dim == 1 ) then cells(:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) else cells(1_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dc32 module procedure to_text_2dc128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then cells(2_int64:,:) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) else cells = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dc128 module procedure to_text_2dc64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then cells(2_int64:,:) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) else cells = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dc64 module procedure to_text_2dc32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then cells(2_int64:,:) = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) else cells = String(x, locale=locale, fmt=fmt, decimals=decimals, im=im) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dc32 module procedure to_text_1dr128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then cells(2_int64:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals) else cells(2_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals) end if else if ( dim == 1 ) then cells(:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals) else cells(1_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dr128 module procedure to_text_1dr64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then cells(2_int64:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals) else cells(2_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals) end if else if ( dim == 1 ) then cells(:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals) else cells(1_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dr64 module procedure to_text_1dr32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then cells(2_int64:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals) else cells(2_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals) end if else if ( dim == 1 ) then cells(:,1_int64) = String(x, locale=locale, fmt=fmt, decimals=decimals) else cells(1_int64,:) = String(x, locale=locale, fmt=fmt, decimals=decimals) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1dr32 module procedure to_text_2dr128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then cells(2_int64:,:) = String(x, locale=locale, fmt=fmt, decimals=decimals) else cells = String(x, locale=locale, fmt=fmt, decimals=decimals) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dr128 module procedure to_text_2dr64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then cells(2_int64:,:) = String(x, locale=locale, fmt=fmt, decimals=decimals) else cells = String(x, locale=locale, fmt=fmt, decimals=decimals) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dr64 module procedure to_text_2dr32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then cells(2_int64:,:) = String(x, locale=locale, fmt=fmt, decimals=decimals) else cells = String(x, locale=locale, fmt=fmt, decimals=decimals) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2dr32 module procedure to_text_1di64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then cells(2_int64:,1_int64) = String(x, fmt=fmt) else cells(2_int64,:) = String(x, fmt=fmt) end if else if ( dim == 1 ) then cells(:,1_int64) = String(x, fmt=fmt) else cells(1_int64,:) = String(x, fmt=fmt) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1di64 module procedure to_text_1di32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then cells(2_int64:,1_int64) = String(x, fmt=fmt) else cells(2_int64,:) = String(x, fmt=fmt) end if else if ( dim == 1 ) then cells(:,1_int64) = String(x, fmt=fmt) else cells(1_int64,:) = String(x, fmt=fmt) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1di32 module procedure to_text_1di16 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then cells(2_int64:,1_int64) = String(x, fmt=fmt) else cells(2_int64,:) = String(x, fmt=fmt) end if else if ( dim == 1 ) then cells(:,1_int64) = String(x, fmt=fmt) else cells(1_int64,:) = String(x, fmt=fmt) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1di16 module procedure to_text_1di8 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: nx, j logical :: header_present nx = size(x, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then if ( dim == 1 ) then allocate( cells(nx,1_int64) ) else allocate( cells(1_int64,nx) ) end if else header_present = .true. if ( dim == 1 ) then allocate( cells(nx+1_int64,1_int64) ) cells(1_int64,1_int64) = String( trim(adjustl(header(1_int64))) ) else allocate( cells(2_int64,nx) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=1, kind=int64):ubound(x, dim=1, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if end if else header_present = .true. allocate( cells(2_int64,nx) ) cells(1_int64,:) = String(header) end if if ( header_present ) then if ( dim == 1 ) then cells(2_int64:,1_int64) = String(x, fmt=fmt) else cells(2_int64,:) = String(x, fmt=fmt) end if else if ( dim == 1 ) then cells(:,1_int64) = String(x, fmt=fmt) else cells(1_int64,:) = String(x, fmt=fmt) end if end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_1di8 module procedure to_text_2di64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then cells(2_int64:,:) = String(x, fmt=fmt) else cells = String(x, fmt=fmt) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2di64 module procedure to_text_2di32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then cells(2_int64:,:) = String(x, fmt=fmt) else cells = String(x, fmt=fmt) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2di32 module procedure to_text_2di16 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then cells(2_int64:,:) = String(x, fmt=fmt) else cells = String(x, fmt=fmt) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2di16 module procedure to_text_2di8 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells character(len=:), allocatable :: label integer(int64) :: n_rows, n_cols, j logical :: header_present n_rows = size(x, dim=1, kind=int64) n_cols = size(x, dim=2, kind=int64) header_present = .false. if ( size(header, kind=int64) == 1_int64 ) then if ( all(header == EMPTY_STR) ) then allocate( cells(n_rows,n_cols) ) else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) label = trim(adjustl(header(1_int64))) do concurrent (j = lbound(x, dim=2, kind=int64):ubound(x, dim=2, kind=int64)) cells(1_int64,j) = String(label//str(j)) end do end if else header_present = .true. allocate( cells(n_rows+1_int64,n_cols) ) cells(1_int64,:) = String(header) end if if ( header_present ) then cells(2_int64:,:) = String(x, fmt=fmt) else cells = String(x, fmt=fmt) end if call text_file%write_file(cells, file_name=file_name, row_separator=NL, column_separator=delim) end procedure to_text_2di8 ! Reading Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure from_text_1dc128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block type(String), allocatable, dimension(:) :: rows, columns integer(int64) :: file_length, i integer :: file_unit, iostat logical :: exists inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if rows = text_file%split(separator=NL) if ( rows(size(rows, kind=int64))%len64() < 1_int64 ) then n_rows = size(rows, kind=int64) - 1_int64 else n_rows = size(rows, kind=int64) end if call process_parentheses(rows, column_separator=delim) columns = rows(1_int64)%split(separator=delim) n_cols = size(columns, kind=int64) allocate( cells(n_rows, n_cols) ) cells(1_int64,:) = columns deallocate(columns) do concurrent (i = 2_int64:n_rows) cells(i,:) = rows(i)%split(separator=delim) deallocate(rows(i)%s) end do call re_process_parentheses(cells, column_separator=delim) end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if call text_file%empty() if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_1dc128 module procedure from_text_1dc64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block type(String), allocatable, dimension(:) :: rows, columns integer(int64) :: file_length, i integer :: file_unit, iostat logical :: exists inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if rows = text_file%split(separator=NL) if ( rows(size(rows, kind=int64))%len64() < 1_int64 ) then n_rows = size(rows, kind=int64) - 1_int64 else n_rows = size(rows, kind=int64) end if call process_parentheses(rows, column_separator=delim) columns = rows(1_int64)%split(separator=delim) n_cols = size(columns, kind=int64) allocate( cells(n_rows, n_cols) ) cells(1_int64,:) = columns deallocate(columns) do concurrent (i = 2_int64:n_rows) cells(i,:) = rows(i)%split(separator=delim) deallocate(rows(i)%s) end do call re_process_parentheses(cells, column_separator=delim) end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if call text_file%empty() if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_1dc64 module procedure from_text_1dc32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block type(String), allocatable, dimension(:) :: rows, columns integer(int64) :: file_length, i integer :: file_unit, iostat logical :: exists inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if rows = text_file%split(separator=NL) if ( rows(size(rows, kind=int64))%len64() < 1_int64 ) then n_rows = size(rows, kind=int64) - 1_int64 else n_rows = size(rows, kind=int64) end if call process_parentheses(rows, column_separator=delim) columns = rows(1_int64)%split(separator=delim) n_cols = size(columns, kind=int64) allocate( cells(n_rows, n_cols) ) cells(1_int64,:) = columns deallocate(columns) do concurrent (i = 2_int64:n_rows) cells(i,:) = rows(i)%split(separator=delim) deallocate(rows(i)%s) end do call re_process_parentheses(cells, column_separator=delim) end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if call text_file%empty() if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_1dc32 module procedure from_text_2dc128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block type(String), allocatable, dimension(:) :: rows, columns integer(int64) :: file_length, i integer :: file_unit, iostat logical :: exists inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if rows = text_file%split(separator=NL) if ( rows(size(rows, kind=int64))%len64() < 1_int64 ) then n_rows = size(rows, kind=int64) - 1_int64 else n_rows = size(rows, kind=int64) end if call process_parentheses(rows, column_separator=delim) columns = rows(1_int64)%split(separator=delim) n_cols = size(columns, kind=int64) allocate( cells(n_rows, n_cols) ) cells(1_int64,:) = columns deallocate(columns) do concurrent (i = 2_int64:n_rows) cells(i,:) = rows(i)%split(separator=delim) deallocate(rows(i)%s) end do call re_process_parentheses(cells, column_separator=delim) end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if call text_file%empty() if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_2dc128 module procedure from_text_2dc64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block type(String), allocatable, dimension(:) :: rows, columns integer(int64) :: file_length, i integer :: file_unit, iostat logical :: exists inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if rows = text_file%split(separator=NL) if ( rows(size(rows, kind=int64))%len64() < 1_int64 ) then n_rows = size(rows, kind=int64) - 1_int64 else n_rows = size(rows, kind=int64) end if call process_parentheses(rows, column_separator=delim) columns = rows(1_int64)%split(separator=delim) n_cols = size(columns, kind=int64) allocate( cells(n_rows, n_cols) ) cells(1_int64,:) = columns deallocate(columns) do concurrent (i = 2_int64:n_rows) cells(i,:) = rows(i)%split(separator=delim) deallocate(rows(i)%s) end do call re_process_parentheses(cells, column_separator=delim) end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if call text_file%empty() if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_2dc64 module procedure from_text_2dc32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols if ( len(im) == 0 ) then custom_processing: block type(String), allocatable, dimension(:) :: rows, columns integer(int64) :: file_length, i integer :: file_unit, iostat logical :: exists inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if inquire( file=file_name, size=file_length ) if ( file_length == 0_int64 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". File is empty.' return end if allocate( character(len=file_length) :: text_file%s ) read(unit=file_unit, iostat=iostat) text_file%s close(file_unit) if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if rows = text_file%split(separator=NL) if ( rows(size(rows, kind=int64))%len64() < 1_int64 ) then n_rows = size(rows, kind=int64) - 1_int64 else n_rows = size(rows, kind=int64) end if call process_parentheses(rows, column_separator=delim) columns = rows(1_int64)%split(separator=delim) n_cols = size(columns, kind=int64) allocate( cells(n_rows, n_cols) ) cells(1_int64,:) = columns deallocate(columns) do concurrent (i = 2_int64:n_rows) cells(i,:) = rows(i)%split(separator=delim) deallocate(rows(i)%s) end do call re_process_parentheses(cells, column_separator=delim) end block custom_processing else call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) end if call text_file%empty() if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt, im=im); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt, im=im); return end if end procedure from_text_2dc32 module procedure from_text_1dr128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_1dr128 module procedure from_text_1dr64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_1dr64 module procedure from_text_1dr32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, locale=locale, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_1dr32 module procedure from_text_2dr128 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_2dr128 module procedure from_text_2dr64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_2dr64 module procedure from_text_2dr32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, locale=locale, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, locale=locale, fmt=fmt); return end if end procedure from_text_2dr32 module procedure from_text_1di64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, fmt=fmt); return end if end procedure from_text_1di64 module procedure from_text_1di32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, fmt=fmt); return end if end procedure from_text_1di32 module procedure from_text_1di16 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, fmt=fmt); return end if end procedure from_text_1di16 module procedure from_text_1di8 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( (n_rows > 1_int64) .and. (n_cols > 1_int64) ) then if ( header ) then if ( n_rows /= 2_int64 ) then error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.' return end if else error stop LF//'Error reading file "'//file_name//'". Data cannot fit into one-dimensional array.'// & ' If there are two rows including a header row, specify "header=.true." .' return end if end if if ( n_cols == 1_int64 ) then if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64) ) call cells(2_int64:,1_int64)%cast(into=into, fmt=fmt); return else allocate( into(n_rows) ) call cells(:,1_int64)%cast(into=into, fmt=fmt); return end if end if if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_cols) ) call cells(2_int64,:)%cast(into=into, fmt=fmt); return else allocate( into(n_cols) ) call cells(1_int64,:)%cast(into=into, fmt=fmt); return end if end procedure from_text_1di8 module procedure from_text_2di64 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, fmt=fmt); return end if end procedure from_text_2di64 module procedure from_text_2di32 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, fmt=fmt); return end if end procedure from_text_2di32 module procedure from_text_2di16 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, fmt=fmt); return end if end procedure from_text_2di16 module procedure from_text_2di8 type(String) :: text_file type(String), allocatable, dimension(:,:) :: cells integer(int64) :: n_rows, n_cols call text_file%read_file(file_name, cell_array=cells, row_separator=NL, column_separator=delim) call text_file%empty() n_rows = size(cells, dim=1, kind=int64) n_cols = size(cells, dim=2, kind=int64) if ( header ) then if ( .not. (n_rows > 1_int64) ) then error stop LF//'Error reading file "'//file_name//'". File is empty after header.' return end if allocate( into(n_rows-1_int64,n_cols) ) call cells(2_int64:,:)%cast(into=into, fmt=fmt); return else allocate( into(n_rows,n_cols) ) call cells%cast(into=into, fmt=fmt); return end if end procedure from_text_2di8 ! Internal Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ pure elemental recursive subroutine process_parentheses(row, column_separator) type(String), intent(inout) :: row character(len=*), intent(in) :: column_separator character(len=:), allocatable :: replacement logical :: in_paren integer(int64) :: sep_len, i sep_len = len(column_separator, kind=int64) if ( sep_len == 1_int64 ) then replacement = NUL else replacement = repeat(NUL, ncopies=sep_len) end if i = 1_int64 in_paren = .false. replace_sep: do while ( i <= row%len64()-sep_len+1_int64 ) if ( row%s(i:i) == '(' ) then in_paren = .true. i = i + 1_int64; cycle replace_sep end if if ( row%s(i:i) == ')' ) then in_paren = .false. i = i + 1_int64; cycle replace_sep end if if ( in_paren ) then if ( row%s(i:i+sep_len-1_int64) == column_separator ) then row%s(i:i+sep_len-1_int64) = replacement i = i + sep_len; cycle replace_sep else i = i + 1_int64; cycle replace_sep end if else i = i + 1_int64; cycle replace_sep end if end do replace_sep end subroutine process_parentheses pure elemental recursive subroutine re_process_parentheses(cell, column_separator) type(String), intent(inout) :: cell character(len=*), intent(in) :: column_separator character(len=:), allocatable :: replacement logical :: in_paren integer(int64) :: sep_len, i sep_len = len(column_separator, kind=int64) if ( sep_len == 1_int64 ) then replacement = NUL else replacement = repeat(NUL, ncopies=sep_len) end if i = 1_int64 in_paren = .false. replace_sep: do while ( i <= cell%len64()-sep_len+1_int64 ) if ( cell%s(i:i) == '(' ) then in_paren = .true. i = i + 1_int64; cycle replace_sep end if if ( cell%s(i:i) == ')' ) then in_paren = .false. i = i + 1_int64; cycle replace_sep end if if ( in_paren ) then if ( cell%s(i:i+sep_len-1_int64) == replacement ) then cell%s(i:i+sep_len-1_int64) = column_separator i = i + sep_len; cycle replace_sep else i = i + 1_int64; cycle replace_sep end if else i = i + 1_int64; cycle replace_sep end if end do replace_sep end subroutine re_process_parentheses end submodule text_io submodule (io_fortran_lib) binary_io !! This submodule provides module procedure implementations for the **private interfaces** `to_binary` and !! `from_binary`. contains ! Writing Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure to_binary_1dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dc128 module procedure to_binary_1dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dc64 module procedure to_binary_1dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dc32 module procedure to_binary_2dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dc128 module procedure to_binary_2dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dc64 module procedure to_binary_2dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dc32 module procedure to_binary_3dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dc128 module procedure to_binary_3dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dc64 module procedure to_binary_3dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dc32 module procedure to_binary_4dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dc128 module procedure to_binary_4dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dc64 module procedure to_binary_4dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dc32 module procedure to_binary_5dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dc128 module procedure to_binary_5dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dc64 module procedure to_binary_5dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dc32 module procedure to_binary_6dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dc128 module procedure to_binary_6dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dc64 module procedure to_binary_6dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dc32 module procedure to_binary_7dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dc128 module procedure to_binary_7dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dc64 module procedure to_binary_7dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dc32 module procedure to_binary_8dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dc128 module procedure to_binary_8dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dc64 module procedure to_binary_8dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dc32 module procedure to_binary_9dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dc128 module procedure to_binary_9dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dc64 module procedure to_binary_9dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dc32 module procedure to_binary_10dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dc128 module procedure to_binary_10dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dc64 module procedure to_binary_10dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dc32 module procedure to_binary_11dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dc128 module procedure to_binary_11dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dc64 module procedure to_binary_11dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dc32 module procedure to_binary_12dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dc128 module procedure to_binary_12dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dc64 module procedure to_binary_12dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dc32 module procedure to_binary_13dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dc128 module procedure to_binary_13dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dc64 module procedure to_binary_13dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dc32 module procedure to_binary_14dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dc128 module procedure to_binary_14dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dc64 module procedure to_binary_14dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dc32 module procedure to_binary_15dc128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dc128 module procedure to_binary_15dc64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dc64 module procedure to_binary_15dc32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dc32 module procedure to_binary_1dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dr128 module procedure to_binary_1dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dr64 module procedure to_binary_1dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1dr32 module procedure to_binary_2dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dr128 module procedure to_binary_2dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dr64 module procedure to_binary_2dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2dr32 module procedure to_binary_3dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dr128 module procedure to_binary_3dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dr64 module procedure to_binary_3dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3dr32 module procedure to_binary_4dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dr128 module procedure to_binary_4dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dr64 module procedure to_binary_4dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4dr32 module procedure to_binary_5dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dr128 module procedure to_binary_5dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dr64 module procedure to_binary_5dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5dr32 module procedure to_binary_6dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dr128 module procedure to_binary_6dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dr64 module procedure to_binary_6dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6dr32 module procedure to_binary_7dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dr128 module procedure to_binary_7dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dr64 module procedure to_binary_7dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7dr32 module procedure to_binary_8dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dr128 module procedure to_binary_8dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dr64 module procedure to_binary_8dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8dr32 module procedure to_binary_9dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dr128 module procedure to_binary_9dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dr64 module procedure to_binary_9dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9dr32 module procedure to_binary_10dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dr128 module procedure to_binary_10dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dr64 module procedure to_binary_10dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10dr32 module procedure to_binary_11dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dr128 module procedure to_binary_11dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dr64 module procedure to_binary_11dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11dr32 module procedure to_binary_12dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dr128 module procedure to_binary_12dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dr64 module procedure to_binary_12dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12dr32 module procedure to_binary_13dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dr128 module procedure to_binary_13dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dr64 module procedure to_binary_13dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13dr32 module procedure to_binary_14dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dr128 module procedure to_binary_14dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dr64 module procedure to_binary_14dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14dr32 module procedure to_binary_15dr128 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dr128 module procedure to_binary_15dr64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dr64 module procedure to_binary_15dr32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15dr32 module procedure to_binary_1di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1di64 module procedure to_binary_1di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1di32 module procedure to_binary_1di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1di16 module procedure to_binary_1di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_1di8 module procedure to_binary_2di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2di64 module procedure to_binary_2di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2di32 module procedure to_binary_2di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2di16 module procedure to_binary_2di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_2di8 module procedure to_binary_3di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3di64 module procedure to_binary_3di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3di32 module procedure to_binary_3di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3di16 module procedure to_binary_3di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_3di8 module procedure to_binary_4di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4di64 module procedure to_binary_4di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4di32 module procedure to_binary_4di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4di16 module procedure to_binary_4di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_4di8 module procedure to_binary_5di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5di64 module procedure to_binary_5di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5di32 module procedure to_binary_5di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5di16 module procedure to_binary_5di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_5di8 module procedure to_binary_6di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6di64 module procedure to_binary_6di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6di32 module procedure to_binary_6di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6di16 module procedure to_binary_6di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_6di8 module procedure to_binary_7di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7di64 module procedure to_binary_7di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7di32 module procedure to_binary_7di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7di16 module procedure to_binary_7di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_7di8 module procedure to_binary_8di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8di64 module procedure to_binary_8di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8di32 module procedure to_binary_8di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8di16 module procedure to_binary_8di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_8di8 module procedure to_binary_9di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9di64 module procedure to_binary_9di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9di32 module procedure to_binary_9di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9di16 module procedure to_binary_9di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_9di8 module procedure to_binary_10di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10di64 module procedure to_binary_10di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10di32 module procedure to_binary_10di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10di16 module procedure to_binary_10di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_10di8 module procedure to_binary_11di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11di64 module procedure to_binary_11di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11di32 module procedure to_binary_11di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11di16 module procedure to_binary_11di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_11di8 module procedure to_binary_12di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12di64 module procedure to_binary_12di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12di32 module procedure to_binary_12di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12di16 module procedure to_binary_12di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_12di8 module procedure to_binary_13di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13di64 module procedure to_binary_13di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13di32 module procedure to_binary_13di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13di16 module procedure to_binary_13di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_13di8 module procedure to_binary_14di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14di64 module procedure to_binary_14di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14di32 module procedure to_binary_14di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14di16 module procedure to_binary_14di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_14di8 module procedure to_binary_15di64 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15di64 module procedure to_binary_15di32 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15di32 module procedure to_binary_15di16 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15di16 module procedure to_binary_15di8 logical :: exists integer :: file_unit inquire( file=file_name, exist=exists ) file_unit = output_unit if ( .not. exists ) then open( newunit=file_unit, file=file_name, status='new', form='unformatted', & action='write', access='stream' ) else open( newunit=file_unit, file=file_name, status='replace', form='unformatted', & action='write', access='stream' ) end if write(unit=file_unit) x close(file_unit) end procedure to_binary_15di8 ! Reading Procedures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ module procedure from_binary_1dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dc128 module procedure from_binary_1dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dc64 module procedure from_binary_1dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dc32 module procedure from_binary_2dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dc128 module procedure from_binary_2dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dc64 module procedure from_binary_2dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dc32 module procedure from_binary_3dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dc128 module procedure from_binary_3dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dc64 module procedure from_binary_3dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dc32 module procedure from_binary_4dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dc128 module procedure from_binary_4dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dc64 module procedure from_binary_4dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dc32 module procedure from_binary_5dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dc128 module procedure from_binary_5dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dc64 module procedure from_binary_5dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dc32 module procedure from_binary_6dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dc128 module procedure from_binary_6dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dc64 module procedure from_binary_6dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dc32 module procedure from_binary_7dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dc128 module procedure from_binary_7dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dc64 module procedure from_binary_7dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dc32 module procedure from_binary_8dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dc128 module procedure from_binary_8dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dc64 module procedure from_binary_8dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dc32 module procedure from_binary_9dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dc128 module procedure from_binary_9dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dc64 module procedure from_binary_9dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dc32 module procedure from_binary_10dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dc128 module procedure from_binary_10dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dc64 module procedure from_binary_10dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dc32 module procedure from_binary_11dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dc128 module procedure from_binary_11dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dc64 module procedure from_binary_11dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dc32 module procedure from_binary_12dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dc128 module procedure from_binary_12dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dc64 module procedure from_binary_12dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dc32 module procedure from_binary_13dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dc128 module procedure from_binary_13dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dc64 module procedure from_binary_13dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dc32 module procedure from_binary_14dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dc128 module procedure from_binary_14dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dc64 module procedure from_binary_14dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dc32 module procedure from_binary_15dc128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dc128 module procedure from_binary_15dc64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dc64 module procedure from_binary_15dc32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dc32 module procedure from_binary_1dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dr128 module procedure from_binary_1dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dr64 module procedure from_binary_1dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1dr32 module procedure from_binary_2dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dr128 module procedure from_binary_2dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dr64 module procedure from_binary_2dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2dr32 module procedure from_binary_3dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dr128 module procedure from_binary_3dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dr64 module procedure from_binary_3dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3dr32 module procedure from_binary_4dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dr128 module procedure from_binary_4dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dr64 module procedure from_binary_4dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4dr32 module procedure from_binary_5dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dr128 module procedure from_binary_5dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dr64 module procedure from_binary_5dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5dr32 module procedure from_binary_6dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dr128 module procedure from_binary_6dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dr64 module procedure from_binary_6dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6dr32 module procedure from_binary_7dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dr128 module procedure from_binary_7dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dr64 module procedure from_binary_7dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7dr32 module procedure from_binary_8dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dr128 module procedure from_binary_8dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dr64 module procedure from_binary_8dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8dr32 module procedure from_binary_9dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dr128 module procedure from_binary_9dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dr64 module procedure from_binary_9dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9dr32 module procedure from_binary_10dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dr128 module procedure from_binary_10dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dr64 module procedure from_binary_10dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10dr32 module procedure from_binary_11dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dr128 module procedure from_binary_11dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dr64 module procedure from_binary_11dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11dr32 module procedure from_binary_12dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dr128 module procedure from_binary_12dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dr64 module procedure from_binary_12dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12dr32 module procedure from_binary_13dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dr128 module procedure from_binary_13dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dr64 module procedure from_binary_13dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13dr32 module procedure from_binary_14dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dr128 module procedure from_binary_14dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dr64 module procedure from_binary_14dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14dr32 module procedure from_binary_15dr128 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dr128 module procedure from_binary_15dr64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dr64 module procedure from_binary_15dr32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15dr32 module procedure from_binary_1di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1di64 module procedure from_binary_1di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1di32 module procedure from_binary_1di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1di16 module procedure from_binary_1di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_1di8 module procedure from_binary_2di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2di64 module procedure from_binary_2di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2di32 module procedure from_binary_2di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2di16 module procedure from_binary_2di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_2di8 module procedure from_binary_3di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3di64 module procedure from_binary_3di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3di32 module procedure from_binary_3di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3di16 module procedure from_binary_3di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_3di8 module procedure from_binary_4di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4di64 module procedure from_binary_4di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4di32 module procedure from_binary_4di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4di16 module procedure from_binary_4di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_4di8 module procedure from_binary_5di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5di64 module procedure from_binary_5di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5di32 module procedure from_binary_5di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5di16 module procedure from_binary_5di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_5di8 module procedure from_binary_6di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6di64 module procedure from_binary_6di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6di32 module procedure from_binary_6di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6di16 module procedure from_binary_6di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_6di8 module procedure from_binary_7di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7di64 module procedure from_binary_7di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7di32 module procedure from_binary_7di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7di16 module procedure from_binary_7di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_7di8 module procedure from_binary_8di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8di64 module procedure from_binary_8di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8di32 module procedure from_binary_8di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8di16 module procedure from_binary_8di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_8di8 module procedure from_binary_9di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9di64 module procedure from_binary_9di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9di32 module procedure from_binary_9di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9di16 module procedure from_binary_9di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_9di8 module procedure from_binary_10di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10di64 module procedure from_binary_10di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10di32 module procedure from_binary_10di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10di16 module procedure from_binary_10di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_10di8 module procedure from_binary_11di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11di64 module procedure from_binary_11di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11di32 module procedure from_binary_11di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11di16 module procedure from_binary_11di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_11di8 module procedure from_binary_12di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12di64 module procedure from_binary_12di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12di32 module procedure from_binary_12di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12di16 module procedure from_binary_12di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_12di8 module procedure from_binary_13di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13di64 module procedure from_binary_13di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13di32 module procedure from_binary_13di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13di16 module procedure from_binary_13di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_13di8 module procedure from_binary_14di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14di64 module procedure from_binary_14di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14di32 module procedure from_binary_14di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14di16 module procedure from_binary_14di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_14di8 module procedure from_binary_15di64 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15di64 module procedure from_binary_15di32 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15di32 module procedure from_binary_15di16 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15di16 module procedure from_binary_15di8 logical :: exists integer :: file_unit, iostat inquire( file=file_name, exist=exists ) file_unit = input_unit if ( exists ) then open( newunit=file_unit, file=file_name, status='old', form='unformatted', & action='read', access='stream', position='rewind' ) else error stop LF//'FATAL: Error reading file "'//file_name//'". No such file exists.' return end if allocate( into(data_shape(1), data_shape(2), data_shape(3), data_shape(4), data_shape(5), data_shape(6), & data_shape(7), data_shape(8), data_shape(9), data_shape(10), data_shape(11), data_shape(12), & data_shape(13), data_shape(14), data_shape(15)) ) read(unit=file_unit, iostat=iostat) into if ( iostat > 0 ) then error stop LF//'FATAL: Error reading file "'//file_name//'". iostat is '//str(iostat) return end if close(file_unit) end procedure from_binary_15di8 end submodule binary_io submodule (io_fortran_lib) array_printing !! This submodule provides module procedure implementations for the **public interface** `aprint`. contains module procedure aprint_1dc128 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_1dc128 module procedure aprint_1dc64 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_1dc64 module procedure aprint_1dc32 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_1dc32 module procedure aprint_2dc128 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, j, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)) ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_2dc128 module procedure aprint_2dc64 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, j, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)) ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_2dc64 module procedure aprint_2dc32 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, im_, xre_max_str, xre_min_str, xim_max_str, xim_min_str integer :: i, j, decimals_, l if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if if ( .not. present(im) ) then im_ = 'j' else im_ = trim(adjustl(im)) end if if ( len(im_) > 0 ) then l = len(im_) else l = 3 end if xre_max_str = str(maxval(x%re), fmt=fmt_, decimals=decimals_) xre_min_str = str(minval(x%re), fmt=fmt_, decimals=decimals_) xim_max_str = str(maxval(x%im), fmt=fmt_, decimals=decimals_) xim_min_str = str(minval(x%im), fmt=fmt_, decimals=decimals_) if ( len(xre_max_str) > len(xre_min_str) ) then l = l + len(xre_max_str) else l = l + len(xre_min_str) end if if ( len(xim_max_str) > len(xim_min_str) ) then l = l + len(xim_max_str) else l = l + len(xim_min_str) end if allocate( character(len=l) :: x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)) ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_, im=im_) end do call aprint(x_str) end procedure aprint_2dc32 module procedure aprint_1dr128 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_1dr128 module procedure aprint_1dr64 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_1dr64 module procedure aprint_1dr32 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_1dr32 module procedure aprint_2dr128 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, j, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_2dr128 module procedure aprint_2dr64 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, j, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_2dr64 module procedure aprint_2dr32 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, x_abs_min_str, source integer :: i, j, decimals_ if ( .not. present(fmt) ) then fmt_ = 'f' else if ( any(REAL_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'f' end if end if if ( .not. present(decimals) ) then decimals_ = 2 else decimals_ = decimals end if x_max_str = str(maxval(x), fmt=fmt_, decimals=decimals_) x_min_str = str(minval(x), fmt=fmt_, decimals=decimals_) x_abs_min_str = str(minval(abs(x)), fmt=fmt_, decimals=decimals_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if if ( len(x_abs_min_str) > len(source) ) source = x_abs_min_str allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_, decimals=decimals_) end do call aprint(x_str) end procedure aprint_2dr32 module procedure aprint_1di64 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source integer :: i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_) end do call aprint(x_str) end procedure aprint_1di64 module procedure aprint_1di32 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source integer :: i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_) end do call aprint(x_str) end procedure aprint_1di32 module procedure aprint_1di16 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source integer :: i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_) end do call aprint(x_str) end procedure aprint_1di16 module procedure aprint_1di8 character(len=:), allocatable, dimension(:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source integer :: i if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1)), source=source ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i) = str(x(i), fmt=fmt_) end do call aprint(x_str) end procedure aprint_1di8 module procedure aprint_2di64 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source, str_tmp integer :: i, j if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_) end do call aprint(x_str) end procedure aprint_2di64 module procedure aprint_2di32 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source, str_tmp integer :: i, j if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_) end do call aprint(x_str) end procedure aprint_2di32 module procedure aprint_2di16 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source, str_tmp integer :: i, j if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_) end do call aprint(x_str) end procedure aprint_2di16 module procedure aprint_2di8 character(len=:), allocatable, dimension(:,:) :: x_str character(len=:), allocatable :: fmt_, x_max_str, x_min_str, source, str_tmp integer :: i, j if ( .not. present(fmt) ) then fmt_ = 'i' else if ( any(INT_FMTS == fmt) ) then fmt_ = fmt else fmt_ = 'i' end if end if x_max_str = str(maxval(x), fmt=fmt_) x_min_str = str(minval(x), fmt=fmt_) if ( len(x_max_str) > len(x_min_str) ) then source = x_max_str else source = x_min_str end if allocate( x_str(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)), source=source ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) x_str(i,j) = str(x(i,j), fmt=fmt_) end do call aprint(x_str) end procedure aprint_2di8 module procedure aprint_1dchar type(String), allocatable, dimension(:) :: rows integer :: i allocate( rows(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent(i = lbound(x, dim=1):ubound(x, dim=1)) if ( i == lbound(x, dim=1) ) then rows(i)%s = LF//' '//adjustl( x(i) ) else if ( i == ubound(x, dim=1) ) then rows(i)%s = ' '//adjustl( x(i) )//LF else rows(i)%s = ' '//adjustl( x(i) ) end if end do do i = lbound(x, dim=1), ubound(x, dim=1) write(*,'(a)') rows(i)%s end do end procedure aprint_1dchar module procedure aprint_2dchar type(String), allocatable, dimension(:) :: rows integer :: i allocate( rows(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent(i = lbound(x, dim=1):ubound(x, dim=1)) if ( i == lbound(x, dim=1) ) then rows(i)%s = LF//' '//accum( x(i,:) ) else if ( i == ubound(x, dim=1) ) then rows(i)%s = ' '//accum( x(i,:) )//LF else rows(i)%s = ' '//accum( x(i,:) ) end if end do do i = lbound(x, dim=1), ubound(x, dim=1) write(*,'(a)') rows(i)%s end do contains pure recursive function accum(x) result(x_str) character(len=*), dimension(:), intent(in) :: x character(len=:), allocatable :: x_str integer :: x_len, x_size, i, pos x_len = len(x) x_size = size(x) if ( x_size == 1 ) then x_str = x(1); return end if if ( x_len == 0 ) then x_str = EMPTY_STR; return end if allocate( character(len=x_len*x_size + x_size - 1) :: x_str ) positional_transfer: do concurrent (i = 1:x_size) pos = (i-1)*(x_len + 1) + 1 x_str(pos:pos+x_len-1) = adjustl(x(i)) if ( i < x_size ) x_str(pos+x_len:pos+x_len) = SPACE end do positional_transfer end function accum end procedure aprint_2dchar module procedure aprint_1dString character(len=:), allocatable, dimension(:) :: char_arr integer, allocatable, dimension(:) :: lengths integer :: i, max_length lengths = x%len() max_length = maxval(lengths) allocate( character(len=max_length) :: char_arr(lbound(x, dim=1):ubound(x, dim=1)) ) do concurrent (i = lbound(x, dim=1):ubound(x, dim=1)) if ( lengths(i) < 1 ) then char_arr(i) = EMPTY_STR else char_arr(i) = x(i)%s end if end do call aprint(char_arr) end procedure aprint_1dString module procedure aprint_2dString character(len=:), allocatable, dimension(:,:) :: char_arr integer, allocatable, dimension(:,:) :: lengths integer :: i, j, max_length lengths = x%len() max_length = maxval(lengths) allocate( character(len=max_length) :: & char_arr(lbound(x, dim=1):ubound(x, dim=1), lbound(x, dim=2):ubound(x, dim=2)) ) do concurrent (j = lbound(x, dim=2):ubound(x, dim=2), i = lbound(x, dim=1):ubound(x, dim=1)) if ( lengths(i,j) < 1 ) then char_arr(i,j) = EMPTY_STR else char_arr(i,j) = x(i,j)%s end if end do call aprint(char_arr) end procedure aprint_2dString end submodule array_printing !====================================================================================================================== ! List of workarounds for compiler bugs in ifx 2023.0.0 : ! ------------------------------------------------------- ! 1. In read_file (line 4752), the internal subroutine split_because_ifxbug (line 4965) is called by the form ! |> call split_because_ifxbug(substring, separator, tokens) ! where tokens is intent(out), to replace a functional call to split_string (line 11027) of the form ! |> tokens = substring%split(separator) ! which induces a run-time segmentation fault in the program contained in benchmark.f90 not seen with the ! following compilers: ifort 2021.8.0, gfortran 11.3.0, gfortran 11.2.0. From investigation, the segmentation ! fault seems due to the assignment of arrays of derived type, as the right-hand-side always evaluates as ! expected, and seems to only appear when "-heap-arrays 0" is specified, as required by the large arrays of ! the program contained in benchmark.f90. With small arrays, the same fault occurs with the assignment on line ! 20 of benchmark.f90 as long as "-heap-arrays 0" is specified. ! 2. In join_into_self (line 4630), the recursive call to join_into_self at line 4658 induces a run-time ! segmentation fault in the program contained in benchmark.f90 not seen with the following compilers: ifort ! 2021.8.0, gfortran 11.3.0, gfortran 11.2.0. From investigation, the segmentation fault seems due to the passing ! of the array of derived type. The fault occurs in a majority of runs, but not in every run. To avoid the fault, ! the array to be passed must be constructed element by element and passed as in the "else" section of the "if" ! block. The fault again seems to be induced only when "-heap-arrays 0" is specified and only with ifx 2023.0.0. !======================================================================================================================